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CHAPTER  1 


1.  INTRODUCTION. 

a.  This  manual  is  intended  for  the  programmer  who  has  the  task  of 
maintaining,  transfering  or  modifying  the  Ammunition  Resupply  Model  (ARM). 

This  manual  contains  listings  and  discussion  of  the  ARM  simulation,  as  well  as 
routines  for  editing  data  and  events,  and  a  demand  generation  program. 

(1)  Chapter  one  contains  general  information  about  the  ARM  model; 
including  files,  common  blocks,  and  subroutine  calling  sequences. 

(2)  Chapter  two  gives  a  detailed  description  of  the  major  event 
subroutines  in  ARM. 

(3)  Chapter  three  lists  the  FORTRAN  code  for  the  ARM  model  and  the 
UNIVAC  executive  language  runstreams  that  drive  the  program. 

2.  GENERAL  INFORMATION. 

a.  ARM  Sunmary.  ARM  is  a  set  of  FORTRAN  subroutines  designed  to  assist 
an  analyst  in  studying  the  ammunitior  flow  from  the  Corps  Storage  Area  (CSA) 
to  the  weapons.  ARM  also  models  the  operations  of  the  Ammunition  Transfer 
Points  (ATPs)  and  Ammunition  Supply  Points  (ASPs).  Additional  information  can 
be  found  in  volume  one-Methodology. 

b.  Program  Specifications. 

(1)  Language  and  operating  system.  ARM  is  written  in  standard 
FORTRAN  77,  and  runs  on  the  TRAOOC  Data  Processing  Field  Office  (DPFO)  UNIVAC 
1100/80.  The  driving  runstreams  in  chapter  3  are  written  for  the  UNIVAC 
Symbolic  Stream  Generator  (SSG  processor).  Their  function  is  to  assign  the 
input  and  output  files  for  ARM. 

(2)  Program  size.  There  are  49  subroutines,. consisting  of  about  5000 
lines  of  code,  in  ARM.  This  produces  about  20000  words  of  instrutions  on  the 
UNIVAC,  and  requires  about  50,000  words  in  the  data  bank. 

(3)  Operating  Environment.  ARM  requires  an  interactive  (demand) 
terminal  with  a  printer  and/or  a  CRT.  Output  can  be  routed  to  a  high  speed 
line  printer. 

3.  AN  ARM  OVERVIEW. 

a.  Major  groups  of  subroutines  perform  the  following  functions: 

(1)  Event  Processing. 

(2)  Vehicle  Queue  Processing. 

(3)  Event  Storage  and  Retrieval. 

(4)  Input  and  Output. 
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b.  Event  Processing.  These  subroutines  simulate  the  flow  of  ammunition 
from  the  Corps  Storage  Area  (CSA)  down  to  the  consuming  weapon  systems.  The 
events  are  ASP,  ASPARV,  ASPAR1,  ASPAR2,  ATP,  ATPARV,  ATPAR1 ,  ATPAR2,  CONTRL, 
CSAARV,  CSAOEP,  DEMAND,  ENDSIM,  HASPAR,  HELARV,  RELOAD,  REPORT,  UNTARV,  and 
UNTDEP.  Additional  subroutines  that  aid  in  event  processing  include:  ASPCK, 
OEPASP,  OUALMX,  INTRDK,  LDPWDR,  OPERA,  RDIEXO,  RDJIFF,  and  SERVER.  A  brief 
explanation  of  each  is  in  chapter  2. 

c.  Vehicle  Queue  Processing.  These  subroutines,  in  general,  keep  track 
of  all  vehicles  used  in  ARM  by  performing  various  functions  on  them  in  the 
queue  appopriate  to  the  event  being  simulated.  FINTK,  GETONE,  GETQUE,  NXTQUE, 
PUTQUE,  and  SETQUE  all  perform  vehicle  queue  operations  (see  chapter  3  for 
definition  of  each).  A  summary  of  vehicle  queue  functions  is  presented  in 
paragraph  7. 

d.  Event  storage  and  retrieval  subroutines  are  made  up  of  CREEVT,  GETEVT, 
NEXTEV,  PUTEVT,  SCHED,  and  SEVENT.  This  group  of  subroutines  allow  the  list 
of  events  in  ARM  (Events  Queue)  to  be  kept  current  and  executable.  Paragraph 
6  explains  how  events  are  scheduled. 

e.  Input  and  Output.  This  grouping  permits  various  input/output 
operations,  including  editing  of  data  and  printing  various  output. 

(1)  Initialization,  input  and  output  for  ARM  is  performed  by  EVSTOP, 
INIT,  QINIT,  READF,  TRKPUT,  TRKTIM,  TRUCK,  and  PRINT. 

(2)  The  ARM  program  may  be  supplemented  by  the  EDIT  program  which 
provides  the  capability  of  editing  the  database  between  Critical  Incidents 
(CIs).  Editing  between  CIs  provides  the  ability  to  replicate  results  of  the 
following  Cl.  The  following  subroutines  make  up  program  EDIT: 


EDIT  (main)  PRINT 

EDITD  PUTQUE 

GETONE  READF 

GETQUE  SETQUE 

NXTQUE  TRKPUT 


Note  that  most  of  the  EDIT  program  subroutines  are  also  found  in  the  ARM 
simulation.  Additional  programs  used  to  edit  event  parameters,  are  found  in 
Volume  I. 

f.  Subroutine  Calling  Sequences. 

(1)  All  of  the  routines  in  ARM  are  directly  called  by  other 
subroutines  or  the  main  program,  except  for  the  function  IQ  (which  returns  the 
proper  vehicle  queue  number  from  parameters).  Initially  listed  are  those 
subroutines  which  are  called  by  the  MA INARM  program;  subsequently,  all 
subroutines  are  cross-ref erenced  by  calling  sequences.  Additionally,  common 
blocks  that  are  referenced  by  calling  subroutine  are  provided. 
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(2)  Events  are  subroutines  that  are  allowed  to  be  scheduled  at  some 
future  time,  that  is,  the  calling  arguments  are  stored  (in  a  queue)  along  with 
the  time  in  the  simulation  that  the  event  is  to  happen.  When  the  event  time 
comes  to  pass,  the  calling  arguments  (or  parameters)  are  retrieved  from  the 
queue  by  GETEVT  and  the  event  subroutine  is  called  directly  by  MAINARM.  In 
this  way,  event  execution  may  be  delayed  by  a  given  amount  of  time  from  when 
the  event  was  scheduled.  The  event  type  (e.g.,  type  1  is  DEMAND)  is  saved  in 
the  passing  argument  list  ( I PARM(5 ) )  so  that  MAINARM  can  determine  which  event 
subroutine  to  call.  The  event  type  is  specified  at  the  time  the  event  is 
scheduled. 

(3)  Table  1-1  lists  all  of  the  ARM  subroutines  and  what  they  call. 
Table  1-2  lists  the  subroutines  in  the  EDIT  program  and  which  other 
subroutines  are  referenced  (called)  by  each,  and  which  routines  reference 
each.  In  contrast  to  Table  1-1,  Table  1-3  contains  all  subroutines  and  where 
they  were  called  from  (the  event  type  appears  at  the  left  column).  Tables  1-4 
and  1-5  deal  with  scheduled  (as  opposed  to  called  directly)  events:  what 
routine  schedules  what;  and  what  routine  is  scheduled  by  what,  respectively 
(the  numbers  in  parenthesis  are  event  numbers). 


Table  1-1. 

EVENT 

MAINARM  Calls 

Common 

Calls 

INIT 

AUNIT 

Q INI  T,  SEVEN  T, SCHE  D , TRKT IM , CON  TRL, 

EVENTS 

RDJIFF 

LOG 

QUENUM 

QUEPUT 

NEXTEV 

LQOKEV 

LOG 

1  DEMAND 

LOG 

R  DI EXO ,  SC  HED,  OPERA 

2  RELOAD 

LOG 

iq,DUALMX,FINTK,INTRDK, SCHED.OPERA 

3  UNTDEP 

LOG 

OPERA, INTRDK, SC HED 

4  ATPARV 

LOG 

SCHED,IQ,FINTK,PUTqUE,GETqUE, OPERA, 
INTRDK 

5  ASPARV 

LOG 

SCHED,IQ,ASPCK,GETqUE,PUTOUE 

6  ATP 

LOG 

I q, F I NTK, SC  HED , OPERA, LDPWPR , INTRDK 

7  ASP 

LOG 

iq,FINTK, SCHED.OPERA, INTRDK 

8  UNTARV 

LOG 

OEPASP , SERVER , I Q, PUTqUE, SCHED 

9  CSAARV 

LOG 

PUTqUE,  SCHED, GETqUE 

10  ATPAR1 

LOG 

OPERA, SCHED, iq.PUTOUE.GETqUE, INTRDK 

11  ATPAR2 

LOG 

iq, PUTqUE, OPERA, INTRDK, SCHED 

12  ASPAR1 

LOG 

I q, PUTqUE, OPERA, SCHED.F I NTK, GETOUE, 
INTRDK 

13  ASPAR2 

LOG 

PUTqUE.GETqUE, OPERA, INTRDK, SCHED, iq 
SERVER 

EVENT 


Table  1-1 


(Cont'd) 


MA  INARM  Calls 

Common 

Calls 

14  HELARV 

LOG 

OPERA, SCHED 

15  HASPAR 

LOG 

16  CSAOEP 

LOG 

OPERA, INTRDK, SCHED,PUTqUE,GETqUE 

17  REPORT 

AUNlT  LOG 

TRUCK 

18  C0N7RL 

EDITD, REPORT, SCHED, CREEVT 

19  END  SIM 

AUNIT  LOG 

QUENUM 

QUEPUT 

EVSTOP 

EVENTS 

Subroutine 

Common 

Calls 

ASPCK 

LOG 

SCHED, OPERA 

CREEVT 

READF, SCHED 

OEPASP 

LOG 

GETqUE,  SCHED,  PUTQUE 

DUALMX 

LOG 

IQ.FINTK,  INTRDK,  SCHED 

EDITD 

AUNIT  LOG 

READF 

FINTK 

LOG 

GETqUE, PUTQUE 

GETEVT 

EVENTS 

GETONE 

QUENUM 

qEUPNT 

A 

GETQUE 

qUENUM 

qUEPNT 

INTRDK 

IQ 

LOG 

LDPWDR 

LOG 

IQ.FINTK, PUTQUE 

OPERA 

LOG 

PUTEVT 

EVENTS 

PUTQUE 

qUENUM 
qUEPNT,  LOG 

QINIT 

EVENTS 

RDIEXO 

LOG 

SCHED 

RDJIFF 

REAOF 

AUNIT  LOG 

SCHED 

SCHED 

LOOKEV, PUTEVT, CONTRL 

SERVER 

LOG 

PUTQUE,  SCHED, GETQUE,  IQ.FINTK,  OPERA 

SEVENT 

SCHED 

TRKPUT 

TRKTIM 

LOG 

READF .NXTQUE ,GETQU  E , PUTQU  E, SETQU E .GETONE 

TRUCK 

AUNIT  LOG 

MA INARM 

AUNIT  LOG 

qUENUM 

qUEPNT 

Vr*  lA  ■ 
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TABLE  1-2 


Routine 

Called  by 

EDI  TD 

EDIT 

GETONE 

TRKPUT 

GETQUE 

EDIT, PRINT, TRKPUT 

NXTQUE 

PRINT.TR  KPUT 

PUTQUE 

EDIT, PRINT, TRKPUT 

READF 

EDITD,  TRKPUT 

SETQUE 

TRKPUT 

TRKPUT 

EDIT 

Routine 

Convnon 

Calls 

EDIT 

AUNIT 

LOG 

QUENUM 

EDITD, GETQUE,  PRINT,  PUTQUE,  TRKPUT 

QUEPNT 

EDITD 

AUNIT 

LOG 

QUENUM 

QUEPNT 

READF 

GETQUE 

QUENUM 

QUEPNT 

NXTQUE 

QUENUM 

QUEPNT 

PRINT 

QUENUM 

QUEPNT 

GETQUE, NXTQUE, PUTQUE 

PUTQUE 

LOG 

QUENUM 

QUEPNT 

READF 

SETQUE 

QUENUM 

QUEPNT 

TRKPUT 

GETQUE, NXTQUE, PUTQUE, READF, SETQUE 
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Table  1-3 


Event  Number 

Subroutine 

Called  by 

7 

ASP 

MAINARM 

12 

ASPAR1 

MAINARM 

13 

ASPARA2 

MAINARM 

5 

ASPARV 

MAINARM 

ASPCK 

ASPARV 

6 

ATP 

MAINARM 

10 

ATPAR1 

MAINARM 

11 

ATPAR2 

MAINARM 

4 

ATPARV 

MAINARM 

18 

CONTRL 

INIT,  MAINARM,  SCHED 

CREEVT 

CONTRL 

9 

CSAARV 

MAINARM 

16 

CSAOEP 

MAINARM 

1 

DEMAND 

MAINARM 

DEPASP 

UNTARV 

DUALMX 

RELOAD 

EDITD 

CONTRL 

19 

END SIM 

MAINARM 

EVSTOP 

MAINARM 

FINTK 

ASP,  ASPAR1,  ATP 
ATPARV,  DUALMX,  LDPWDR 
RELOAD,  SERVER 

GETEVT 

NEXTEV 

GETONE 

TRKPUT 
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Table  1-3.  (Cont'd) 


Event  Nuirfcer 

Subroutine 

Called  by 

GETQUE 

ASPAR1  ASPAR2,  ASPARV, 
ATP ART,  ATPARV,  CSAARV, 
CSADEP,  DEPASP,  FINTK, 
SERVER 

15 

HASPAR 

MAINPRM 

14 

HELARV 

MAINARM 

INIT 

MAINARM 

INTRDK 

ASP,  ASPAR1 ,  ASPAR2, 
ATP,  ATPAR1 ,  ATPAR2, 
ATPARV,  CSADEP,  DUALMX, 
RELOAD,  UNTDEP 

IQ 

ASP,  ASP ART ,  ASPAR2, 
ASPARV,  ATP,  ATPAR1 , 
ATPAR2,  ATPARV,  OUALMX, 
LDPWDR,  RELOAD,  SERVER 
UNTARV 

LOPWOR 

ATP 

LOOKEV 

MAINARM 

NEXTEV 

MAINARM 

OPERA 

ASP,  ASPAR1,  ASPAR2, 

ASP CK,  ATP,  ATPAR1, 
ATPAR2,  ATPARV,  CSADEP, 
DEMAND,  HELARV,  RELOAD, 
SERVER,  UNTDEP 

PUTEVT 

SCHED 

PUTQUE 

ASPAR1,  ASPAR3,  ASPARV, 
ATPAR1 ,  ATPAR2,  ATPARV, 
CSAARV,  CSADEP,  DEPASP, 
FINTK,  LDPWDR,  SERVER, 
UNTARV 

QINIT 

INIT 

ROIEXO 

DEMAND 

RDJIFF 

INIT 
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Table  1-3.  (Cont'd) 

Event  Number 

Subroutine 

Called  by 

1 

READF 

CREEVT,  EDITD,  TRKPUT 

J 

2 

RELOAD 

MAINARM 

17 

REPORT 

CONTRL,  MAINARM 

i 

SCHED 

ASP,  ASPAR1 ,  AS PAR 2, 

ASPARV,  ASP CK,  ATP, 

ATPAR1,  ATPAR2,  ATPARV, 

CONTRL,  CREEVT,  CSAARV, 

4 

CSAOEP,  DEMAND,  OEPASP, 
DUALMX,  HELARV,  INIT, 

RDIEXO,  RDJIFF,  RELOAD, 

i 

SERVER,  SEVENT,  UNTARV, 
UNTDEP 

* 

SERVER 

ASPAR2,  UNTARV 

i 

SEVENT 

INIT 

TRKPUT 

CONTRL 

TRKTIM 

INIT 

i 

TRUCK 

REPORT 

8 

UNTARV 

MAINARM 

3 

UNTDEP 

MAINARM 

* 
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TABLE  1-4 


NAME 

DEMAND 

RELOAD 

UNTDEP 

ATPARV 

ASPARV 

ATP 

ASP 

UNTARV 

CSAARV 

ATPAR1 

ATPAR2 

ASPAR1 

ASPAR2 

HELARV 

HASPAR 

CSADEP 

REPORT 

CON7RL 


SCHEDULED  BY 

RDIEXQ.RDJIFF 

DEMAND, UNTARV 

DUALMX,RE LOAD 

ATP, ATPARV, UNTDEP 

ASP, ASPARV, ASP CK, 

ATP .ATPARV , DUALMX, 
RELOAD, UNTDEP 

ATPARV.DEPASP, SERVER 

ASPARV, DEP ASP, SERVER 

ASP.ASPARl ,ATP, 
DUALMX, RELOAD, SERVER 

ASPAR2.ASPAR1 

ATP.ATPARl, CSADEP 

ASPAR1 ,ASPAR2,ATP 

ASPAR1.ASPAR2, SERVER 

ASP.ASPARl .ASPAR2, 
ATPAR1, CSADEP, SERVER 

DEMAND 

DEMAND, HELARV 
CSAARV 

CQNTRL 

CONTRL,  INIT 


END SIM 


Table  1-5 


Routine 

ASP 

ASPAR1 

ASPAR2 

ASPARV 

ASPCK 

ATP 

ATPAR1 

ATPAR2 

ATPARV 

CREEVT 

CONTRL 

CSAARV 

CSADEP 

DEMAND 

DEPASP 

DUALMX 

HELARV 

INIT 

ROIEXO 

RDJIFF 


Schedules 

(5)  ASPARV,  (8)  UNTARV,  (13)  ASPAR2 

(12)  ASPAR1 ,  (13)  ASPAR2,  (8)  UNTARV,  (11)  ATPAR2 

(9)  CSAARV,  (13)  ASPAR2,  (11)  ATPAR2 

(5)  ASPARV,  (7)  ASP 

(5)  ASPARV 

(4)  ATPARV,  (5)  ASPARV,  (8)  UNTARV,  (10)  ATPAR1 , 

(11)  ATPAR2 

(13)  ASPAR2,  (10)  ATPAR2,  (9)  CSAARV 

(12)  ASPAR1 

(5)  ASPARV,  (6)  ATP,  (4)  ATPARV 

SCHEDULES  ANY  EVENT 

(18)  CONTRL,  (19)  ENDSIM 

(16)  CSAOEP 

(10)  ATP ART ,  (13)  ASPAR2 

(2)  RELOAD,  (15)  HASPAR,  (14)  HELARV 
(7)  ASP,  (6)  ATP 

(5)  ASPARV,  (3)  UNTDEP,  (8)  UNTARV 

(15)  HASPAR 

(19)  ENDSIM 

(1)  DEMAND 

(1)  DEMAND 

(5)  UNTDEP,  (8)  UNTARV 


RELOAD 


EVT#  Routine 

SERVER 


(8) 

(3) 


SEVENT 
UNTAR V 


Schedules 

(8)  UNTARV,  (6)  ATP,  (7)  ASP,  (12)  ASPAR1 , 
(13)  ASPAR2 

SCHEDULES  ANY  EVENT 

(2)  RELOAD 

(5)  ASPARV,  (4)  ATPARV 


UNTDEP 


4.  File  Usage 

a.  The  ARM  program  use  the  following  files  (see  Volume  I  for  details): 

2  Audit  trail  (output),  a  listing  of  all  events  that  were  scheduled 
or  executed. 

3  Database  input  at  start  of  Cl. 

4  Database  output  at  the  end  of  the  Cl. 

7  Events  file,  input,  to  be  executed  during  this  Cl  (generated  by 
previous  Cl). 

8  Events  file,  output,  to  be  executed  during  the  next  Cl. 

9  Demand  (input),  the  expenditure  rates  for  the  unit  weapons. 

11  Additional  events  (input)  to  be  executed  this  Cl.  This  file  is 

manually  built  in  program  ADDEVT  (see  Volume  I). 

14  Unit  status  report  output. 

b.  Program  EDIT  uses  these  files: 

2  Printout  of  truck  queues. 

3  Database  input  to  be  edited. 

4  Database  output  after  editing. 

13  Distance  file,  input,  to  be  stored  in  the  IUNIT  array  distance 
attributes.  The  distances  must  change  to  reflect  unit  movement 
(see  Volume  I). 

5.  COMMON  BLOCKS. 

a.  EVENTS.  EVENTS  is  the  events  queue.  It  is  accessed  from:  INIT, 
EVSTOP,  GETEVT,  PUTEVT,  QINIT.  An  explanation  of  how  it  is  used  can  be  found 
in  paragraph  6.  The  common  declaration  is  referenced  with  the  "include 
events"  statement: 

COMMON/EVENTS/ JSTAT(6),  JEVDS(2048,  4),  IEVS(5,  2048) 

b.  QUENUM.  Contains  IHEAD,  the  list  of  last  item  in  queue  for  vehicle 
queues  (see  paragraph  6): 

C0MM0 N/ QUEN UM/ IHEAD ( 17 6 ) 
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c.  QUEPNT.  The  ITEMS  in  the  vehicle  aueue  are  held  in  common  QUEPNT. 
QUEPNT  is  used  in  association  with  QUENIIM  (see  paragraph  6): 

COMMON/ QUEPNT/ ITEMS  ( 1400) 

d.  AUNIT.  Contains  the  alphabetic  unit  names: 

COMMO  N/AUN IT/AUN I T  ( 7  5 , 2 ) 

e.  LOG.  Contains  the  database  for  the  ARM  model  (see  volume  I  for  the 
array  definitions): 

COMMON/LOG/ IATP( 10,53),  IASP(lO.llO),  IUNIT(75, 142) , 

Z  I  TRUCK  ( 1400, 15) ,  ITYPE(9,6),  IMIX(91,32),  INTER  (10), 

Z  IRSTME(23,3),  IATPSD(5),  IDAY,  TIME, 

Z  IATPAM(  10,40),  ICSA(3,32),  LPPAR(IO),  IASPAM(10,120) , 

Z  LUOUT,  TCIST,  TCILNG,  L00K(19),  JUNIT(8,24), 

Z  JATP(10,6) ,  JASP( 10,9) ,  IATPSP( 10,22) , 

Z  IASPSP( 10,30),  IAMLVL(2,30) ,  ISERV(IO) 

6.  THE  EVENTS  QUEUE. 

a.  The  flexibility  of  ARM  comes  from  the  ability  of  its  subroutines  to 
schedule  events  to  happen  at  some  future  time.  On  the  most  fundamental  level, 
this  is  done  by  sorting  tne  events  in  chronological  order  and  storing  them  in 
the  events  queue  (list)  for  future  processing. 

b.  Events  are  scheduled  by  calling  subroutine  SCHED  and  passing  the  event 
type  (see  table  1-1),  calling  arguments  and  the  time  the  event  is  to  take 
place.  SCHED  calls  PUTEVT  to  put  the  event  in  the  event  queue. 

c.  The  parameters  (arguments)  associated  with  the  event  at  the  time  it 
was  scheduled  are  the  thing  that  makes  that  event  unique.  For  example,  if  a 
truck  is  scheduled  for  an  event  at  some  future  time,  the  first  of  five 
parameters  is  generally  the  truck  number.  The  parameter  list  for  an  event  is 
usually  given  the  name  IPARM. 

d.  If  an  event  is  scheduled  at  the  current  time,  (i.e.,  no  delay  is 
assessed  at  time  of  scheduling)  then  that  event  will  be  the  first  event  in 
queue  (next  to  be  executed),  even  if  there  were  events  scheduled  for  that  time 
previously. 

e.  The  structure  of  the  events  queue  may  be  found  in  figure  1-2.  In 
general,  JEVDS  is  a  doubly  linked  list  of  events,  sorted  by  time.  The  double 
linkage  allows  insertion  from  either  the  front  or  rear.  IEVS  contains  the 
parameters  (IPPRMs)  associated  with  the  event  when  it  was  scheduled  JSTAT(l) 
contains  the  subscript  to  JEVDS  and  IEVS  of  the  next  event  in  queue  (front). 
Subsequent  events  are  found  by  following  the  subscript  to  the  next  event 
(found  in  JEVDS  (IFIRST,!),  and  so  on). 
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Figure  1-2.  Events  Queue. 


7.  VEHICLE  QUEUES. 


a.  Because  several  vehicles  may  wait  in  the  same  place  at  a  given  time,  a 
vehicle  queueing  system  has  been  set  up  for  ARM.  To  put  a  vehicle  (NTRUCK)  in 
queue  (NQUEUE),  a  subroutine  must  "CALL  PUTQUE  (NTRUCK,  NQUEUE)."  Similarly 
to  pull  a  vehicle  from  queue,  a  "CALL  GETQUE  (NTRUCK,  NQUEUE)"  is  executed. 

b.  There  are  two  arrays  that  make  up  the  vehicle  gueues  (see  figure  1-3), 
IHEAD  and  ITEMS.  IHEAD  is  found  in  common  block  QUENUM;  ITEMS  is  in  QUEPNT. 
IHEAO  (NQUEUE)  contains  the  number  of  the  last  vehicle  in  queue  "NQUEUE."  The 
vehicle  in  front  of  NTRUCK  in  queue  is  given  by  ITEMS( NTRUCK ) .  In  order  to 
get  to  the  first  item  in  queue,  it  is  necessary  to  traverse  through  the 
pointers  until  you  reach  the  element  of  array  ITEMS  that  contains  a  zero. 

c.  Since  IHEAD  is  dimensioned  to  176,  there  are  176  possible  queues. 

ITEMS  is  dimensioned  to  1400,  so  there  are  1400  vehicles  that  can  be  in  any 
combination  of  the  176  queues. 
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Figure  1-3.  Truck  Queues. 
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CHAPTER  2 


1.  MAIN ARM. 

a.  The  general  logic  of  MAINARM  is  as  follows: 

(1)  Initialize,  read  database. 

(2)  The  following  is  repeated  until  simulation  end: 

Get  an  event. 

Process  the  event. 

(3)  Write  out  the  database  for  the  next  Cl. 

(4)  Stop. 

b.  Initialization  Routines. 

(1)  INIT.  INIT  reads  the  database  from  file  3.  The  database  is  held 
in  common  for  the  rest  of  the  Critical  Incident  (Cl).  This  allows  all  of  the 
events  to  modify  the  data.  The  list  of  the  arrays  in  the  database  and  their 
definitions  can  be  found  in  Volume  I.  INIT  gives  the  operator  access  to  the 
ARM  menu  by  calling  CQNTRL. 

(2)  INIT  calls  RDJIFF  which  reads  the  demand  file  (file  9)  and 
updates  the  demand  attributes  in  the  IUNIT  array  for  each  ammo  type.  RDJIFF 
schedules  the  first  DEMAND  pulse  (for  each  unit)  for  the  Cl. 

c.  Event  Processing:  MAINARM  processes  events  as  they  appear  in  the 
'events  queue'  (common  events,  see  paragraph  6,  Volume  II).  NEXTEV  retrieves 
the  next  scheduled  event  by  calling  GETEVT.  MAINARM  calls  LOOKEV  to  print  the 
event  message  on  the  audit  trail  (file  2). 

Event  subroutines  are  called  from  MAINARM  dependent  on  the  event  type 
( I PARM(5 ) ,  see  Table  1-1  for  explanation  of  the  codes),  until  the  event  ENDSIM 
is  processed. 

2.  EVENT  DESCRIPTIONS. 

a.  OEMAND.  DEMAND  simulates  the  ammunition  consumption  at  the  unit 
level,  DEMAND  calls  RDIEXO  to  fire  that  portion  of  the  Cl's  ammunition  demand 
allocated  to  this  pulse  (an  instantaneous  expenditure  of  ammunition  as 
represented  by  the  scenario  and  demand  generation  process).  For  a  maneuver 
unit,  all  of  the  demand  is  fired  (at  the  end  of  the  Cl),  because  they  are  only 
pulsed  once  per  Cl.  For  multipulse  units,  RDIEXO  schedules  the  next  DEMAND 
event  for  this  Cl.  For  artillery  units,  the  DEMAND  event  is  scheduled  every 
60  minutes.  For  155mm  units,  if  current  supply  plus  ammunition  on  trucks  is 
less  than  the  critical  resupply  level,  an  emergency  helicopter  resupply  event 
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(HELARV)  is  scheduled.  RDIEXO  expends  the  ammunition  by  subtracting  part  of 
the  demand  from  the  current  supply.  If  current  supply  per  weapon  falls  below 

the  routine  resupply  level  for  at  least  one  ammunition  type,  a  RELOAD  event  is 
scheduled  inmediately. 

b.  RELOAD. 

(1)  RELOAD  transfers  ammunition  from  the  unit  trucks  to  the  weapons. 
The  number  of  rounds  to  be  taken  from  each  truck  is  determined  by  taking  the 
total  requirements  of  the  unit  divided  by  the  number  of  weapons  needing 
ammunition  (from  IUNIT  array).  Transfer  is  accomplished  by  multiplying  the 
percent  of  the  trucks  load  (ITRUCK(N,6))  by  the  quantities  in  the  IMIX  array 
for  the  particular  mix  the  truck  is  carrying  ( I  TRUCK  (  N,5) ) . 

(2)  After  completion  of  the  reload,  the  truck  is  scheduled  to  return 
to  the  combat  trains  or  assembly  area.  If  the  truck  is  empty  it  will  return 
through  a  UNTDEP  (unit  departure)  to  the  ASP  or  ATP  for  another  load  (see 
paragraph  2d.  below).  Otherwise,  the  truck  will  wait  at  the  unit  for  the  next 
RELOAD  event. 

c.  UNTARV  (arrival  of  a  unit  truck  at  the  unit).  UNTARV  brings  the  truck 
back  to  the  unit  combat  trains  (if  it  is  a  maneuver  unit)  or  the  assembly  area 
(for  an  artillery  unit).  The  ammunition-on-trucks  attributes  in  the  IUNIT 
array  are  incremented  by  the  ammunition  load  of  the  returning  truck.  UNTARV 
may  schedule  a  RELOAD  event  if  there  is  an  outstanding  demand  for  the  type  of 
ammo  on  the  returning  truck. 

d.  UNTDEP  (departure  of  a  unit  truck  from  the  assembly  area  or  combat 
trains).  If  upon  completion  of  a  RELOAD  event  the  truck  is  empty,  a  unit 
departure  is  scheduled.  This  event  checks  for  the  most  needed  type  at  the 
unit.  If  that  ammunition  type  is  stocked  at  the  ATP,  an  ATP  arrival  (ATPARV) 
event  is  scheduled.  The  arrival  time  is  based  upon  the  distance  from  the  unit 
to  the  ATP  and  the  average  speed  of  the  truck.  If  the  needed  ammunition  type 
is  not  stocked  at  the  ATP,  then  the  arrival  time  to  the  ASP  is  calculated  and 
an  ASP  arrival  (ASPARV)  event  is  scheduled. 

e.  ATPARV  (arrival  of  a  unit  truck  at  the  ATP).  When  the  ATPARV  event  is 
executed,  the  ATPARV  subroutine  checks  to  see  that  the  ammunition  type 
required  by  the  arriving  truck  is  on-hand  at  the  servicing  ATP.  If  the  needed 
ammunition  type  is  available  at  this  ATP,  ATPARV  looks  in  queue  for  a  free 
server  (a  piece  of  Materiel  Handing  Equipment,  MHE,  i.e.  a  forklift  or  a 
crane),  and  a  S&P  with  the  proper  ammunition  mix.  If  either  the  server  or  the 
S&P  is  unavailable  (busy  or  not  present),  the  unit  truck  is  placed  in  queue  to 
wait  for  a  free  server.  When  both  a  server  and  an  S&P  with  the  proper  mix  are 
available,  ATPARV  schedules  an  ATP  event  to  load  the  unit  truck  (the  server 
and  unit  truck  number  are  passed  as  IPARMS  when  the  event  is  scheduled),  and 
the  S&P  is  put  in  queue.  If  the  needed  ammunition  type  is  not  available  at 
this  ATP,  then  the  truck  is  bumped  to  the  associated  ASP  by  scheduling  an 
ASPARV. 
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f.  ATP  (service  of  a  unit  truck  at  the  ATP).  The  ATP  event  simulates  the 
transloading  of  ammunition  from  an  S&P  to  a  unit  truck.  This  is  accomplished 
by  decrementing  the  load  on  the  S&P  and  incrementing  the  unit  truck  load, 
using  the  IM I X  array  (for  number  of  rounds)  and  the  ITRUCK  array  (ITRUCK  6 
which  is  the  percent  loaded  and  ITRUCK  5  which  is  the  mix  on  the  vehicle).  If 
the  S&P  runs  out  of  ammunition  before  the  unit  truck  is  full,  ATP  looks  for 
another  S&P  to  finish  loading  the  unit  truck  (if  none  are  available,  the  unit 
truck  goes  through  an  ATPARV) .  The  empty  S&P  goes  through  an  ATPAR1  (on  the 
way  to  the  CSA)  if  it  is  a  CSA-ATP  truck.  If  the  empty  S&P  belongs  to  the 
ASP,  it  is  scheduled  for  an  ATPAR2  (for  an  eventual  reload).  When  the  unit 
truck  finishes  loading,  it  is  scheduled  for  a  UNTARV  to  return  it  to  the 
unit.  The  UNTARV  routine  is  also  used  (in  the  ATP  subroutine)  to  schedule  the 
return  of  a  server  to  the  proper  queue  in  the  ATP. 

g.  ATPAR1  (arrival  of  a  CSA-ATP  S&P  at  the  ATP). 

(1)  The  major  function  of  ATPAR1  is  to  accept  S&Ps  coming  into  the 
ATP.  This  includes  full  trucks  coming  from  the  CSA  and  empty  (or  partially 
empty)  trucks  returning  to  queue  from  reloading  a  unit  truck  in  the  ATP  event. 

(2)  ATPAR1  also  handles  the  redistribution  function  of  the  Division 
Ammunition  Officer  (DAO).  S&P  trucks  arriving  at  the  DAO  from  the  CSA 

( I PARM(4)  will  be  333)  are  scheduled  into  the  ATP  that  needs  the  ammunition 
the  most  (another  ATPAR1 ) .  This  represents  the  diversion  of  these  trucks  to 
where  they  are  needed  the  most. 

Empty  trucks  are  sent  to  the  CSA  through  a  CSAARV.  Partially  loaded  trucks 
are  put  in  queue. 

h.  CSAARV  (arrival  of  an  empty  S&P  at  the  CSA).  CSAARV  increments  the 
throughput  at  the  CSA,  and  sets  the  load  attribute  of  the  S&P  to  a  full  load 
(ITRUCK(N,6)=10000) .  If  the  S&P  is  from  an  ASP,  then  CSAARV  checks  each  ASP 
to  find  the  ASP  and  ammunition  type  that  is  needed  the  most.  A  CSADEP  event 
is  scheduled  to  return  the  S&P  to  the  ATP  or  ASP. 

i.  CSADEP  (departure  of  a  full  S&P  from  the  CSA).  S&Ps  travel  from  the 
CSA  forward  in  convoys.  CSA  to  ATP  convoys  contain  three  trucks;  a  CSA  to  ASP 
convoy  is  seven  trucks.  The  S&Ps  wait  in  queue  until  there  are  enough  going 
to  the  same  place  to  form  a  convoy.  When  a  convoy  is  formed,  trucks  are 
dispached  to  arrive  at  their  destination  one  minute  apart.  ASP  convoys  go 
through  the  ASPAR2  event.  ATP  convoys  go  to  the  DAO  by  scheduling  an  ATPAR1 
with  IPARM(4)  set  to  333  (see  g  above). 

j.  ATPAR2  (arrival  of  an  ASP  S&P  truck  at  the  ATP).  ATPAR2  processes  ASP 
S&P  trucks  at  the  ATP.  Empty  ATP-ASP  S&P  trucks  are  scheduled  for  an  ASPAR1 
to  load  from  stocks  at  the  ASP.  Full  S&P  trucks  returning  from  the  ASP,  as 
well  as  partially  full  S&P  trucks  (returning  from  loading  unit  trucks  in  the 
ATP),  are  placed  in  the  S&P  queue  at  the  ATP,  by  this  routine. 


k.  ASPAR1.  ASPAR1  simulates  the  arrival  of  an  ASP-ATP  S&P  truck  at  the 

ASP. 

(1)  The  S&P  tractor  will  exchange  an  empty  trailer  for  a  full  one,  if 
one  of  the  right  mix  is  available.  Otherwise,  ASPAR1  attempts  to  locate  a 
server  to  load  the  empty  trailer  from  the  ground.  If  no  servers  are 
available,  the  tractor  and  empty  trailer  wait  in  queue  for  a  returning 
server.  If  there  is  not  sufficient  ammunition  available  on  trailers  or  on  the 
ground,  the  S&P  will  be  "bumped"  to  the  rear  ASP  by  scheduling  another 
ASPAR1.  In  the  case  when  there  is  no  ammunition  at  the  rear  ASP,  the  S&P 
truck  waits  in  queue. 

(2)  The  filled  truck  returns  to  the  ATP  through  an  ATPAR2.  The 
server  is  released  by  scheduling  a  UNTARV.  If  the  ATP  S&P  switched  trailers 
with  a  CSA  S&P  truck,  the  CSA  truck  is  returned  by  scheduling  an  ASPAR2. 

l.  ASPARV  (arrival  of  a  unit  truck  at  the  ASP).  ASPARV  works  much  the 
same  way  as  ATPARV,  in  that  it  sets  up  the  unit  truck  for  loading  (at  the 
ASP).  ASPARV  locates  a  server  and  schedules  an  ASP  event  to  load  the  truck 
from  the  ground  or  a  waiting  S&P.  If  the  needed  type  is  out  of  stock  at  this 
ASP,  then  ASPCK  will  find  another  ASP  that  has  the  needed  type.  The  truck 
must  wait  in  queue  if  no  ASP  has  the  needed  ammunition.  MLRS  trucks  are 
self-loading  and  require  no  server.  Only  three  MLRS  may  load  at  one  time; 
additional  MLRS  must  wait  in  queue. 

m.  ASP.  The  ASP  event  reloads  a  unit  truck  at  the  ASP.  ASP  will  get  an 
S&P  from  the  queue  if  one  is  available,  to  load  the  unit  truck.  If  the  S&P 
runs  out  of  ammunition,  ASP  schedules  the  return  of  the  empty  S&P  truck 
(ASPAR2),  and  gets  another  from  queue  to  service  unit  trucks  needs.  When  no 
more  S&Ps  are  available,  ASP  will  load  the  unit  truck  from  stocks  on  the 
ground. 


n.  ASPAR2.  ASPAR2  handles  ASP -CSA  S&P  trucks. 

(1)  Empty  S&Ps  are  put  into  queue  until  seven  are  ready  to  be  sent  to 
the  CSA  in  convoy.  Trucks  in  a  convoy  are  scheduled  to  arrive  at  the  CSA 
(CSAARV)  one  minute  apart. 

(2)  Full  S&P  trucks  arriving  from  the  CSA  look  for  an  empty  ATP-ASP 
S&P  waiting  in  queue  for  their  ammunition  type.  If  a  match  is  found  they  will 
switch  trailers,  the  ATP-ASP  truck  (full)  returns  to  the  ATP  (ATPAR2).  The 
ASP-CSA  truck  (empty)  is  scheduled  through  an  ASPAR2  to  go  to  the  CSA.  If  no 
ATP  trucks  are  waiting  then  ASPAR2  looks  for  a  server,  and  puts  the  S&P  in 
queue  to  be  offloaded.  If  a  server  was  found,  ASPAR2  calls  SERVER  to  offload 
the  trucks  in  queue. 

(3)  Partially  full  S&Ps  returning  from  loading  unit  trucks  in  the  ASP 
event  are  scheduled  for  an  ASPAR2  to  be  put  in  their  proper  queue. 
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o.  HELARV  (arrival  of  a  helicopter  (CH-47)  at  an  artillery  unit).  When 
155mm  artillery  units  become  critically  short  of  ammunition,  DEMAND  will 
schedule  a  HELARV  event.  This  subroutine  increments  the  ammunition  supply  in 
the  IUNIT  array,  and  schedules  a  HASPAR  that  returns  the  helicopter  to  the 
ASP.  It  is  assumed  that  the  helicopter  was  idle  and  the  cargo  bags  were 
preloaded  at  the  ASP  for  the  helicopter  to  pick  up. 

p.  HASPAR  (return  of  a  helicopter  to  the  ASP).  HASPAR  simulates  the 
return  of  the  helicopter  to  the  available  queue  and  its  eventual  reload  in 
preparation  for  another  aerial  resupply.  Subroutine  SERVER  is  called  to  load 
the  cargo  bags  of  the  helicopter  at  the  ASP. 

3.  Special  purpose  routines. 

a.  OPERA. 

(1)  Each  time  a  truck  is  scheduled  to  move  (or  for  MHE,  scheduled  to 
be  used),  the  routine  scheduling  this  action  calls  subroutine  OPERA  to  check 
the  operational  availability  of  that  vehicle.  Each  vehicle  has  its  own  clock 
that  keeps  track  of  the  vehicle's  time  to  next  failure  (in  minutes).  Time  to 
next  failure  is  maintained  (stored)  in  ITRUCK  (N,7),  and  is  exponentially 
distributed  about  the  mean  time  to  fail  (MTTF)  for  the  vehicle  type. 

(2)  When  a  vehicle  is  scheduled  to  move  from  one  location  to  another 
(or  is  in  use  for  a  period  of  time),  the  travel  time  is  subtracted  from  the 
time  to  next  failure.  If  the  time  to  fail  reaches  zero,  then  the  vehicle  is 
delayed  by  a  repair  time,  which  is  a  random  variable,  log  normally  distributed 
about  the  mean  time  to  repair  (MTTR)  for  the  given  vehicle  type. 

b.  IN7RDK  (vehicle  interdiction). 

(1)  Whenever  a  subroutine  schedules  an  event  that  causes  a  vehicle  to 
move,  it  calls  IN1RDK  to  find  out  if  the  vehicle  completes  the  move.  The 
division  area  of  operations  is  divided  into  two  zones  for  interdiction 
purposes.  Zone  one  extends  from  line  of  contact  to  the  brigade  rear 
boundary.  Zone  two  is  the  area  from  the  brigade  rear  boundary  back  to  the 
corps  storage  area. 

(2)  The  operator  inputs  parameters  to  the  database  in  array  INTER, 
which  are  derived  from  the  scenario.  For  each  zone,  there  is  a  maximum  number 
of  interdictions,  a  modulo  number,  and  a  counter  which  accumulates  number  of 
trucks  who  have  travelled  this  Cl  (see  array  definition  of  INTER  for  more 
information).  If  the  number  of  trucks  traveling  through  the  zone  this  Cl  is 
evenly  divisible  by  the  modulo  for  the  zone  (using  modular  arithmetic),  then 
this  truck  will  be  killed.  If  a  unit  truck  is  interdicted,  the  time  of 
interdiction  is  stored  in  the  IUNIT  array  ( IUN IT ( N, 6) )  to  evenly  distribute 
the  total  interdictions  for  a  Cl  over  all  units  with  trucks  on  the  road. 
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c.  DUALMX  (reload  mortars  and  25  mm  ammunition.  Since  mortar  and  25  mm 
armiunition  are  carried  on  the  same  unit  truck,  and  are  fired  at  different 
rates,  RELOAD  cannot  handle  reloading  these  weapons.  RELOAD  calls  DUALMX  to 
reload  mortars  and  25  mm  weapons.  DUALMX  finds  which  type  has  the  greatest 
need,  and  loads  both  weapons  to  the  same  percentage  of  truck  load.  This  is 
done  so  the  percent  load  in  the  1TRUCK  array  will  represent  both  ammunition 
types.  As  in  RELOAD,  partially  loaded  trucks  are  scheduled  into  a  UNTARV. 
Empty  trucks  go  through  UNTDEP  to  the  ASP. 

d.  LDPWDR  (load  powder  on  artillery  truck  at  the  ATP).  LDPWDR  is  called 
by  ATP  to  finish  loading  an  artillery  (unit)  truck  with  powder  and  fuzes. 

e.  ASPCK  (check  alternate  ASPs  for  ammo).  ASPCK  checks  for  the  needed 
ammunition  at  the  sister  and  rear  ASPs,  and  schedules  the  unit  truck  into  an 
ASPARV  if  anrno  ia  available.  If  ammunition  is  unavailable  at  alternate  ASPs, 
the  truck  is  kept  at  the  current  ASP  and  ASPCK  returns  a  777  in  IPARM(4)  to 
the  calling  routine. 

f.  DEPASP  (departure  of  a  MLRS  truck  from  the  ASP  or  ATP).  Since  only 
three  MLRS  trucks  may  load  at  any  one  time,  DEPASP  brings  the  next  MLRS  truck 
in  when  one  finishes  loading.  This  is  accomplished  by  scheduling  a  false 
UNTARV  event  for  the  newly  loaded  unit  truck  (IPARM  (2)*0  for  ASP;  -1  for 
ATP).  An  ATP  or  ASP  event  will  be  scheduled  for  the  new  truck. 

g.  SERVER  (release  of  a  server  at  the  ATP  or  ASP).  SERVER  is  called  from 
UNTARV  to  process  a  server  when  it  comes  available.  It  looks  for  a  unit  truck 
in  queue  to  load  in  an  ATP  or  ASP  event.  At  the  ASP,  SERVER  may  find  a  CSA 
S&P  to  offload  or  an  ATP  S&P  to  load.  When  there  are  no  more  trucks  to  be 
serviced,  the  server  is  put  in  queue. 


a.  Subroutine  mainarm 

CHARACTER*^  aunit 

p 

INCLUDE  LOG. LIST 
INCLUDE  OUENUM » LIST 
INCLUDE  QUEF'NI .LIST 
INCLUDE  AUNIT. LIST 
DIMENSION  I  FARM ( 5 ) 

C«**  MAIN.  H.  JONES  DEC  73 
C 

C****  UNIT  2  REPORT  FILE 

C*m  UNIT  3  INPUT  DATA.  COMMONS  LOG.  OUENUM.  TJE.-NT 

C*.***  UNIT  4  OUTPUT  DATA.  COMMONS  LOG.  OUENUM.  3UEPNT 

C****  UNIT  5  KEYBOARD 

C****  UNIT  6  DISPLAY 

Cm*  UNIT  7  INPUT  DATA.  COMMON  EVENTS 

cm*  UNIT  3  OUTPUT  DATA.  COMMON  EVENTS 

cm*  UNIT  ?  INPUT  DATA.  DEMAND  FILE 
cm*  UNIT  11  INPUT  DATA.  CONVOY  EVENTS 
C 

C  DICTIONARY 

C  - 

C  DIST  The  distance  between  two  specified  locations.  St-e  TVLTIM. 

C  IGUNER  The  owner  number  of  the  vehicle,  attribute ( 4 )  of  the  vehici 

C  in  the  ITRUCK  array. 

C  ITKTYP  The  vehicle  type,  attributed )  of  the  vehicle  in  the  ITRUCK 
C  array. 

C  L0AD()  The  number  of  rounds  of  the  specified  type  loaded  on  the 
C  vehicle,  see  also  ND<), 

C  MIX  The  mi:<  of  3«nuntion  on  vehicle,  attributed)  of  the  ITRUCK 

C  array.  For  a  aiven  mi;:  number,  the  number  of  rounds  for 

C  each  ammuntion  type  is  listed  in  the  IMIX  3rroy. 

C  MIXGET  The  MIX  of  ammunition  that  an  empty  unit/trains  truck  is 
C  beina  sent  to  3et  from  either  the  ATP  or  the  ASP. 

C  NASP  The  ASP  number  from  the  I ASP  array.  (1..6) 

C  NATP  The  ATP  number  from  the  IATP  array.  ( 1 . . 6 > 

C  NOO  The  number  of  rounds  of  the  specified  ammunition  typo  neeoe 

C  demanded,  or  required.  See  3lso  L0AD<). 

C  NRONTK  The  total  number  of  rounds  on  the  vehicle. 

C  NUMAM  Ammumition  type,  usually  used  in  DO  LOOP  control. 

C  NUMRD  The  total  number  of  rounds  needed,  demanded  or  required. 

C  NUMSP  The  SiF'  number  from  the  ITRUCK  array. 

C  NUMSVR  The  server  number  from  the  ITRUCK  ar-ay. 

C  NUMTK  The  truck  number  from  the  ITRUCK  army. 

C  NUNIT  The  unit  number  from  the  IUNIT  array  for  either  units  or 

C  b3tt3lions. 

C  TDELA  The  time  delay  for  vehicle  t'or  server)  providins  ammunition 

C  TFAIL  The  duration  of  maintenance  failure  for  a  vehicle. 

C  T3NDLD  The  time  to  load  truck  recievina  ammunition  from  steers  on 

C  the  around. 

C  TLOAD  The  time  to  l03d  vehicle  reciavina  ammuntion. 

C  TMIND  The  duration  of  non-availability  due  to  enemy  interaction  - 

C  TQFFl.D  The  time  to  off-load  ammunition  to  the  around  from  3  truck. 

C  TOTIM  The  sum  of  all  loading  or  delay  times. 
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c 

Cm*  INITIALIZE  SIMULATION 
CALL  INIT 
C 

C ****  GET  AND  PROCESS  EACH  EVENT 

5  CALL  NEXTE'.1  (KIND*  IPARM,  TIME) 

IF (KIND  .LT.  1  .OR.  KIND  .GT.  1?)  URITE(6,7>  KIND 
7  FORMAT''  EVENT  TYPE  '  ,  15 » '  OUT  OF  RANKE') 

CALL  LQQKEV  (KIND+O.  IPARM.  TIMErO.,  1 ) 

GO  TO  (10. 20.30.40. 50. 60. 70*30. 90. 100. 110. 120. 130. 140, 
Z  150.160.170.130.190).  KIND 

C»***  CHECKS  AMMO  DEMAND  OF  UNIT 
10  CALL  DEMAND  (IPARM) 

GO  TO  5 
C 

Cm*  REPLACES  ROUNDS  OF  AMMO  AT  UNIT  WEAPONS 
20  CALL  RELOAD  (IPARM) 

GO  TO  5 
C 

Cm*  DEPARTURE  OF  TRUCK  FROM  UNIT 
30  CALL  UNTDE?  (IPARM) 

GO  TO  5 
C 

Cm*  ARRIVAL  OF  UNIT  TRUCK  AT  ATP 
40  CALL  ATPARV  (IPARM) 

GO  TO  5 
C 

Cm*  ARRIVAL  OF  UNIT  TRUCK  AT  ASP 
50  CALL  ASPARV  (IPARM) 

GO  TO  5 

cm*  SERVICE  OF  UNIT  TRUCK  FROM  QUEUE  AT  ATP 
60  CALL  ATP  (IPARM) 

GO  TO  5 

C*#**  SERVICE  OF  UNIT  TRUCK  FROM  QUEUE  AT  ASP 
70  CALL  ASP  (IPARM) 

GO  TO  3 
C 

C****  ARRIVAL  OF  TRUCK  AT  UNIT 
80  CALL  UNTARV  (IPARM) 

GO  TO  5 

Cm*  ARRIVAL  OF  TRUCK  AT  CSA  (FROM  ATP  OR  ASP) 

90  CALL  CSAARV  (IPARM) 

GO  TO  3 

£ 

Cm*  ARRIVAL  OF  AT?  Si?  FROM  CSA 
100  CALL  ATPAR1  (IPARM) 

30  TO  3 
r 

C*m  ARRIVAL  OF  ASP  S  i  P  AT  AT? 

110  CALL  ATPAR2  (IPARM) 


n 


<_>  c>  «.j  o  o  tj  o  «j  o 


KXX*  ARRIVAL  OF  ASP  S  i  P  AT  ASP  ( FROM  AT 
120  CALL  ASPAR1  (IP ARM) 

GO  TO  5 

****  ARRIVAL  OF  CSA  S  i  P  AT  ASP 
130  CALL  A3PAR2  (IPARM) 

GO  TO  5 

«***  ARRIVAL  OF  HELICOPTER  AT  UNIT 
140  CALL  HELARV  (IPARM) 

GO  TO  5 

****  ARRIVAL  OF  HELICOPTER  AT  AS? 

150  CALL  HASPAR  (IPARM) 

GO  TO  5 

*:«**  DEPARTURE  OF  S  1  P  FROM  CSA 
ISO  CALL  CSADEP  (IPARM) 

GO  TO  5 


C***X 

170 

C 

C*X»* 

ISO 

c 

c:m* 

190 


REPORT 

CALL  REPORT  (IPARM) 

GO  TO  5 

INTERACTIVE  CONTROL  (MENU) 
CALL  CONTRL  (TIME) 

GO  TO  5 


SIMULATION  END 
CALL  ENDSIM( IPARM) 
CALL  EVSTQP 


SUBROUTINE  ASP 
SUBROUTINE  ASP  ( IP ARM > 

C ****  EVENT  ASP  —  SERVICE  OF  TRUCK  FROM  QUEUE  AT  ASP , 

C  NAY  LOAD  UNIT  TRUCK  FROM  A  S.'P  OR  GROUND. 

C  ALL  EXCEPT  MLRS  NEED  SERVERS. 

C  EVENT  TYPE  7 

C  CALLED  BY  MAINARM 

C  CALLS  IQ*  FINTK .  SCHED.  OPERA.  INTRDK 

C 

Cl***  J.  FOX  JAN  79 
C 

Cl***  IPARM(l)  --  1  =  ROUTINE  QUEUE.  2  =  MS  SS  QUEUE 

Cl***  IPARM( 2)  —  ASP  NUMBER 

Cl***  IPARM( 3)  —  UNIT  TRUCK  NUMBER 

C***l  IPARM ( 4 )  —  SERVER  NUMBER  (FOR  MLR3  .  SAME  AS  TRUCK) 

C 

0***1  SCHEDULES  --  UNTARV.  ARRIVAL  OF  TRUCK  AT  UNIT 
C  OR  SERVER 

C  ASPAR2.  RELEASE  OF  5SP 

C  ASPARV .  INTERDICTED  UNIT  TRUCK 

C 

C**l*  SCHEDULED  BY  ASPARV.  DEPASP.  SERVER 

■'****  (2)  CALCULATES  LOAD  TIME  AS  FUNCTION  OF  LOAD  MIX 
C****  NUMBER  AND  NUMBER  OF  SERVERS  ACTIVE  FOR  THIS  QUEUE. 

C 

C**»*  NOTE  "!  IN  THIS  ROUTINE  ITRUCK(X»3)  CONTAINS  THE  TIME  THE 
C****  THAT  TRUCK  NUMTK  ARRIVED  AT  THE  ASP  ! ! ! 

C»***  CHECKS  —  DELAY  DUE  TO  HTBF  AND  INTERDICTION. 

INCLUDE  LOO. LIST 
DIMENSION  IPhRM<5) .IIPARM(S) 

J  LOCAL  VARIABLE  DEFINITION 

C  NASPO  -  QUEUE  NUMBER  TO  BE  SERVICED 
C  NUMTK  -TRUCK  TO  BE  SERVED 

C  NUMSP  -  SSP  TRK  FROM  C3A  TO  ASP 

C  MIX  -AMMO  MIX  INDEX  ON  UNIT  TRUCKS 
MIXSP  -  MIX  ON  CSA  TRUCK 
i;  NRONTK  -  NO.  OF  ROUNDS  ON  CSA  TRUCK 
C  TLOAD  -  TIME  FOR  A  SERVER  TO  LOAD  ONE  TRUCK 

C  ITKTYR  -  TYRE  op  TRUCK  TO  BE  SERVED 

C  NUN  IT  -  UNIT  NUMBER  OWNING  THE  TRUCK 

C  DIST  -  DISTANCE  BETWEEN  ASP  AND  UNIT  OR  CSA  AND  ASP 
C  TVLHM  -  TRAVEL  TIME 

0  TRAIL  -  TIME  LOST  DUE  TO  FAILURE 

0  TMIND  -  TIME  LOST  DUE  TO  INTERDICTION 

U  TOTIM  -TIME  OF  SCHEDULED  EVENT 

IQTYC'E  =  IPARM' D 
MAS?  =  IPARM<2>  -  10 
1 1  j  M  T  K  «  IP ARM'S) 

•NijMSRV  s  IPARM' 4! 

IPARM(3)  =  0 
I  : ARM ! 4 )  =  0 


cm* 


cm* 


c***x 


LOAD  =  0. 
FLAG  =  0 
IFLA6  =  0 


FIND  THE  VALUE  FOR  THE  QUEUE:  1  FOR  ROUTINE*  4  FOR  HI.RS 
KVAL  =  1 

IF  ( IQTYF'E  .  EQ .  2)  KVAL  =  4 

FIND  THE  QUEUE  WAIT  TIME  AND  ADD  IT  TO  TOTAL  QUEUE  TIME 
NTQUE  =  TIME  -  I  TRUCK ( NUMTK • 3 ) 

ITRUCK < NUMTK  >  12 )  =  I  TRUCK ( NUMTK *  12 )  +  NTQUE 

JASP  < NAS?  *  KVALt 1 )  »  JASP  (  NASP  *  KVAL+1 )  +  NTQUE 

IF  THIS  IS  THE  LONGEST  QUEUE  WAIT  RECORD  IT 

IF < NTQUE. 3T. JASP < NASP .KVAL+2) )  JASP • NASP *KVAL+2)=NTQUE 

ADD  ONE  TO  THE  NUMBER  SERVED 

JASP (NASP* KVAL)  =  JASP ( NASP * KVAL )  +  1 

MIX  =  ITRUCK ( NUMTK *  5 ) 

FIND  AMMO  TYPE  WANTED.  ASSUME  ONLY  ONE  TYPE. 

DO  30  NUMAM  =  1  * LPPAR ( 1 ) 

IF  ( IMIX ( MIX • NUMAM )  .LE.  0)60  TO  30 

RECORD  NUMBER  OF  ROUNDS  NEEDED  -NRNDSN  AND  TYPE  OF  RDS 
NRNDSN  =  IMIX ( MIX  * NUMAM ) 

CHECK  IF  THERE  IS  AMMO  ON  CSA  TRUCKS 
NASF'Q  =  IQ  ( 7  *  NASP ) 

CALL  FINTK (NASPQ. NUMAM. NUMSP. 0) 

IF  NO  TRUCK.  GO  TO  GROUND  LD  UP 
IF ( NUMSP  .EG.  0)  GO  TO  70 

FIND  THE  NUMBER  OF  ROUNDS  ON  NUMSP.  IF  SUFFICIENT*  DECREMENT 
AMMO*  SCHEDULE  UNTARV.  PUT  TRUCK  BACK  IN  ASP  Q. 

IF  INSUFFICIENT,  EMPTY  S*P  TRUCK » SEND  TO  CSA*  DECREMENT 
THE  NUMBER  OF  ROUNDS  REQUIRED*  FIND  ANOTHER  TRUCK  WITH 
PROPER  AMMO  OR  COMPLETE  LOADING  FROM  STOCK. 

UPDATE  PER  CENT  ROUNDS  ON  THE  TRUCK. 

MIXSP  =  I  TRUCK (NUMSP* 5) 

NRONTK  =  • IMIX ( MIXSP  *  NUMAM ) *  I  TRUCK ( NUMSP  *fc)+?9??}/ 10000 
ITRUCK( NUMSRV *  13)  =  ITRUCK(NUMSRV*13>  +  1  3  LOAD  FROM  CSA  SiP 
IF  INSUFFICIENT  ROUNDS  GO  TO  SO 
IF  (NRNDSN  .GT.  NRONTK )  GO  TO  SC- 

SUFFICIENT  AMMO  ON  TRUCK*  DECREMENT  AMMO  ON  TRUCK 
I  TRUCK ( NUMSP  *  6 )  =  1 0000* ( NRONTK  -  NRNDSN )/ IMIX ( MIXSP * NUMAM ) 

IF ( ITRUCK (NUMSP. o)  .Ed.  0)  GO  TO  SO 
IFCFLA6  .EG.  1  > THEN 
RNOS  =  NRNDSN 
RNDAV  =  FRNN 

TOELAY  =  TDSLAY  r  IMIX ( MIX » 32 )  *  ( RNDS/RNDAV) 

ELSE 

f DELAY  =  IMIX (MIX *32) 

END  IF 

SCHEDULE  RELEASE  OF  S  i  P 
IIPARM(l)  =  NASP  +  10 
I IPARM ( 2 )  =  NUMSP 
1 1? ARM ( 3 )  =  0 
:i?arm(4>  =  999 

CALL  SCHED( 13* IIPARM* TIME  *  T DELAY)  3  ASP AR2 


(RNDS/RNDAV 


C  INSUFFICIENT  AMMO  OR  EXACTLY  ENOUGH  AMMO  GN  SIP 
C  TIME  TO  SHIFT  PARTIAL  LOAD 
SO  FRNN=  NRNDSN 

TLOAD  =  IMIX(MIX»32)  *  NRONTK  /  FSNN 
IF  (IDAY  .EQ.  0)  TLOAD  =  1.54*TL0AD 
TDELAY  =  TDELAY  +  TLOAD  +5.0 

NRNDSN  =  NRNDSN  -  NRONTK 
ITRUCK ( NUMSP  » 6 )  =  0 
IIPARM(l)  -  NASP  +  10 
IIPARM<2)  =  NUMSP 
1 1 PARM  <  3 )  =  0 
1 1  F  ARM ( 4 )  *  555 

CALL  3CHEDU3»IIF'ARK,TIME  r  TDELAY)  3  ASPAR2 

IFLAG  =  1 

C  IF  EXACTLY  ENOUGH  ROUNDS  ON  TRUCK .  SEND  BACK  TO  UNIT 
IF ( NRNDSN  .EG.  0)  GO  TO  30 
C  GO  GET  ANOTHER  SIR  TRUCK  TO  COMPLETE  THE  LOAD 
C  OR  COMPLETE  FROM  ON  THE  GROUND  STOCK 
GO  TO  50 

70  NRST  =  NRNDSN 

TTLOAD  =  TLOAD  +  ( IMIX(MIX.32) >*(NRST  /  IMIX'HIX. NUMAM) ) 

IF  (IDAY  .EQ.  0)  TTLOAD  *  1.544TTL0AD 
TDELAY  =  TDELAY  +  TTLOAD 
Cm*  DECREMENT  AMMO  AVAILABLE 
90  CONTINUE 

IASP(NA3P.NUMAM*3+18)  =  I  ASP ( NASP . NUMAM*3+1S )  -  IMIX(MIX. NUMAM) 
IF(IASP(NASP»NUMAM*3  +  18).LT.  OJPRINT*. INT(TIME) . '  NO  AMMO ' > NUMAM* 
*  '  AT  ASP' .NASP 

lASPAM(NASP.MIX)  *  I ASP AM (NASP. MIX)  +  1  8  INCR  *  TRUCKS  SERVICED 

C  *  *  *  DECREMENT  'DEMAND1 

I  ASP  <  NASP  »NUMAM*3+19)  =  I  ASP ( NASP . NUMAM*3+ 1? )  -  IMIX ( MIX . NUMAM ) 
•:****  IF  ARTY  AMMO  DECREMENT  POWDER  AND  FUZES 

IF (NUMAM  ,GT.  3  .AND.  NUMAM  .LT.  S  .OR.  NUMAM  .GT.  10  .AND.  NUMAM 
Z  .LT.  1-4)  THEN 

IASRCNASP.27)  =  IASP(NASP.27)  -  IMIX(MIX. NUMAM) 

IASP(NASP.73)  =  I  ASP (NASP. 73)  -  IMIX  <  MIX . NUMAM) 

END  IF 

IF ( NUMAM  .GT.5  .AND.  NUMAM  .LT.  3  .OR.  NUMAM  .EQ.  15) THEN 
IASP(NASP.42)  =  IASP ( NASP » 42 )  -  IMIX ( MIX . NUMAM  ) 

I  ASP  ( NASP .  73 )  =  IASP(NASF’»79>  -  IMIX(MIX.  NUMAM) 

END  IF 

30  CONTINUE 

C  *  *  *  DECREMENT  NUMBER  TRUCK  IN  QUEUE 
IF ( NFLAG  .EQ.  1)  GC  TO  100 

IASP ( NASF’»  IQTYPE+1 1 )  =  IASP  ( NASP .  IGTYPE+1 1 )  -  1 

IF ( IASP (NASP* IQTYPE+11 )  .LT.  0 > PRINT* .  INT ( TIME ) . ' GUE '  * NASP  +  10 . 

Z  IASP (HASP* IGTYPE+1 1) » '  IN  THE  ASP' 

C  FIND  TYPE  OF  TRUCK  AND  COMPUTE  TRAVEL  TIME 
ITKTYP  =  ' TRUCK l NUMTK*  1 ) 

NUN  IT  =  I  TRUCK (NUMTK. 4  ) 

DIST  =  IUNI T •' NUNIT  ?  5  ) 

IF' ((NASP  -  10)  -  UNIT (NUNIT .3) )  .EG.  1  .OR.  ( (NASP  +  10) 

-  UNIT (NUN IT* 3) >  .EG.  -1 ) DIST  =  DIST  +  15. 

IF  (UNASP  +  10)  -  UNIT  (NUNIT  .3) )  .EG.  2)  DIST  =  DIST  + 
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TVLTIM  =  60.  *  DIST  /  ITYPE(  ITKTYP,  IDAY-ri ) 

I  TRUCK (NUMTK, 3)  =  4 
CALL  I NTRDK (NUMTK » TMIND  ) 

IF( TMIND  .LE.  0.)  THEN 

CALL  OF'ERA  <  NUMTK  »  TVLTIM » TFA IL ) 

ELSE 

TFAIL  =  0. 

END  IF 

TQTIM  =  TIME  +  TDELAY 
SCHEDULE  UNTARV 
I FARM ( 1 )  -  NUN  IT 
IP ARM ( 2 )  =  NUMTK 

TQTIM  =  TIME  4  TDELAY  +  TMIND  +  TFAIL  +  TVLTIM 
IF  NO  INTERDICTION.  BYPASS. 

IF (TMIND  .LE.  0)50  TO  100 
TGTIM=TOTIM  +  TDELAY 

NFLAG  =1  5  TO  CHARGE  2D  LOAD  OF  AMMO 

GO  TO  30 
100  CONTINUE 

ADD  ONE  TO  THE  NUMBER  OF  TRUCKS  TRAVELING  FROM  ASP  TO  UNIT 
ITKTYP  =  IUNIT ( NUNIT » 1 ) 

JUNIT ( ITKTYP, 17)  =  JUNIT< ITKTYP, 17)  +  1 

ADD  TO  THE  NUMBER  OF  KILLED  OR  FAILED  ON  THIS  TRIP 

IF (TMIND  .GT.  0)  JUNIT( ITKTYP, IS)  =  JUNIT < ITKTYP, 13 )  +  1 

IF( TFAIL  .GT.  0)  JUNIT ( ITKTYP, 19)  =  JUNIT( ITKTYP , 19 )  +  1 

ADD  THE  WAIT  AND  LOAD  AND  TRAVEL  TIME  TO  THE  TOTAL  TIME 

JUNIT ( ITKTYP , 20 )  =  JUNITC ITKTYP, 20)  +  N7QUE  +  TTLOAD  +  TVLTIM 

IF ( TMIND  .GT.  0) THEN 

IPARM<3)  =  I  UN  IT (NUN  IT ,3) 

CALL  SCHED(S,IPARM, TMIND  +  TIME)  3  ASPARV 

I  TRUCK (NUMTK, 6)  =  0 
ELSE 

CALL  SCHED(3,IPARM, TQTIM)  3  UNTARV 

I  TRUCK ( NUMTK , 6 )  =  10000 
END  IF 

IF ( KVAL  .EG.  D  THEN 

***  SCHEDULE  THE  AVAILABILITY  OF  THE  SERVER 

CALL  OPERA (NUMSRV, TDELAY .TTFAIL) 

DTI  ME  =  TIME  +  TDELAY  +  TTFAIL 
IPARM(l)  =  NASP  +  10 
IPARM<  2)  =  NUMSRV 
IPARM ( 3 )  =  1 

CALL  SCHED ( 3 • IPARM , DTI  ME)  3  UNTARV 

I  TRUCK  ( NUMSRV ,  6 )  =  ITR'JCK  ( NUMSRV .  6 )  +  TDELAY 
IF (ITRUCK( NUMTK, 1)  .EQ.  1 ) THEN 

ITRUCK(  NUMSRV,  12)  =  ITRIJCK(  NUMSRV ,  12  )  r  1  3  10TON  COUNT 
ELSE 

I  TRUCK (NUMSRV, 11 )  =  I TRUCK (NUMSRV, 11 )  +  1  3  5T0N  COUNTS 
END  IF 
ELSE 


**# 


THIS  ALLOWS 


SCHEDULE  THE  DEPARTURE  OF  THE  MLRS  TRUCK, 


(TOO  O  O  O  O  O  O  CT) 


C.  SUBROUTINE  ASPARV 

SUBROUTINE  ASPARV  (IPARM) 

CM***  EVENT  ASPARV  —  ARRIVAL  Or  UNIT  TRUCK  AT  ASP 
C  FIND  A  SERVER.  SSP  — >  3CHEB  ASP 

EVENT  TYPE  5 

CALLED  BY  MAINARM 

CALLS  SCHED.  IQ.  ASPCK.  GETQUE .  PUTQUE 
****  J.  FOX  JAN  79 


*:m  IPARM <  1 )  —  UNIT  NUMBER 
****  IPARM< 2)  —  TRUCK  NUMBER 
****  IPARM(3)  —  ASP  NUMBER 
CM***  IPARM  < 4 )  —  MIX  ON  TRUCK  COMING  INTO  PROGRAM 
Cm*  THIS  EVENT  PUTS  TRUCK  IN  PROPER  ASP  QUEUE. 


C  SCHEDULES  --  ASP  SERVICE  OF  UNIT  TRUCK  FROM  QUEUE  AT  ASP 
C  < IF  ASP  SERVICE  FOR  THIS  QUEUE  IS  IDLE) 

C  ASPARV.  (ITSELF)  AS  A  FALSE  EVENT 

C  SCHEDULED  BY  ASP.  ASPARV.  ASPCK.  ATP.  ATPARV ,  DUALMX.  RELOAD. 

C*m***CHANGES - IPARM ( 4 )  TO  SERVER  NUMBER 

INCLUDE  LOG. LIST 
DIMENSION  IPARM ( 5 ) 

C 

C  LOCAL  VARIABLES 

C  MIX  -  THE  INDEX  OF  THE  AMMO  TYPE  FROM  IMIX 

C  NASPQ  -  QUEUE  FOR  TRUCK 

C  NUMQ  -  SERVER  QUEUE 

C  IND  -  INDEX  TO  COUNT  TRUCKS  QUEUE 
C  NASP  -  ASP  NUMBER 


JNTD 


NUNIT  =  IPARM ( I ) 

MUMTK  =  IPARM (2) 

NASP  =  IPARM(3)  -  10 
I PARM ( 4 )  =  0 
C 

C  DETERMINE  AMMO  MIX  INDEX. 

MIX  =  ITRUCK(NUHTK»5) 

C  ***  IF  UNIT  TRUCK  ENTERING  ASPARV  IS  FROM  INTERDICTION  OR  BREAK- 
C  DOWN  AND  ASP  *  HAS  CHANGED.  SCHED  ASPARV  30  MIN  LATER. 

IF ( ITRUCK (NUMTK .2)  .NF.  9 > THEN  3  IF  EQ..  OLD  ASP  INT ' S 5  SKIP 
IOUNER  =  ITRUCK ( NUMTK . 4  ) 

LAS?  =  I UN I T ( IOUNER .3 ) 

IF'NASP  +  10  .NE.  LASP ) THEN 
IPARM ( 3 )  =  LASP 
I?ARM( 4)  =  MIX 

CALL  SCHED (5. IPARM. TIME  4  30.)  3  ASPARV 

RETURN 
END  IF 
END  IF 

C  ASSUME  NO  MLRS  IN  MIX 
NASPQ  =  IQ (3. NASP) 

IND  =  12 


**!* 


C  *  * 


‘  TRUCK  HAS  INTERDICTED*  ADD  AKMQ  TO  UNIT  ROUNDS  DUE  IN 
IF  ( I  TRUCK  •:  NUMTK  *  3 )  .EQ.  7)  THEN 
00  1  I  =  1  *  LPPAR  ( 6 ) 

NAM  =  I  *  13  -  5 

IF< IUNIT ( IPARM ( 1 ) *  NAM )  .37.  0)  THEN 

IUNIT(NUNIT.NAM+12)  =  IUN IT ( NUNIT * NAM+12 )  + 

:  IMI X (MIX?I UN ITi NUNIT  *NAM i ) 

END  IF 
CONTINUE 
END  IF 

*  DETERMINE  AMMO  TYPE 
NUMAM  =  MIX 

IF (MIX  ,GT.  LPPAR ( 7) ) NUMAM  =  MIX  -  LPPAR(7> 


C  *  *  IF  .EQ.  9.  TRUCK  ARRIVED  FROM  ANOTHER  ASP 

IF(ITRUCK(NUMTK*2)  .EQ.  9) IASP(NASP*NUMAM  *  3  +  19)  = 

S  I  ASP ( NASP  *  NUMAM  .*  3  +  1?)  -  IMIX  ( MIX  *  NUMAM ) 

C  *  %  *  DETERMINE  IF  SUFFICIENT  AMMO  ON  HAND  (IF  'ON  HAND*  -  'DEMAND 
C  <  'NEEDED') 

IF(IASP(NASP*NUMAM*3+18)  -  IASP (N ASP* NUMAM *3+19 )  . LT . 

*  I  MIX (MIX* NUMAM) )THEN 

IF ( I  TRUCK ( NUMTK  >2)  .£3.  9)G0  TO  10 
CALL  ASPCM IPARM) 

IF ( IPARM<  4 )  .ME.  777)RET'JRN 
ELSE 

ITRUCK(NUMTK»2>  =  1 
END  IF 

C  SET  ITRUCKCN.3)  EQUAL  TO  THE  TIME  OF  QUEUE  ENTRY*  THIS 

C  'JILL  ALLOW  QUEUE  WAIT  TIME  TO  BE  FOUND  FOR  THE  TRUCK 

10-  I  TRUCK ( NUMTK  *  3 )  =  TIME 
C  INCREMENT  NUMBER  OF  TRUCKS  IN  QUEUE 
IASP(NASPjIND)  =  I  ASP (NASP* IND)  +1 
C  *  *  *  INCREMENT  'DEMAND* 

DO  20  I AM  =  1  * LPPAR ( 1 ) 

IASP<NASP»IAM*3+1?)  =  I ASP ( HASP  *  I AM*3+1? )  +  IMIX( MIX  *  I  AM ) 

20  CONTINUE 

C  *  *  .*  IF  EQ  9 » THIS  IS  SECOND  AS?  AND  NO  AMMO  —  PUT  IN  QUEUE 
IF ( ITRUCK ( NUMTK  *  2 )  .EQ.  9)30  TO  5 
C  *  «  «  IF  EQ  777*  NOT  ENOUGH  AMMO  AT  ANY  ASPS  --  PUT  IN  QUEUE 
IF ( !PARM( 4)  .EQ.  777)30  TO  5 
C  «  *  FIND  AMMO  TYPE  NEEDED 
Ztatt  IF  MLRS  SCHEDULE  THE  ASP  EVENT 
C  IF  THERE  ARE  LESS  THAN  3  TRUCKS  ALREADY  LOADING 
IF (NUMAM  .EQ.  10 ) THEN 

IF ( I ASP ! NASP * 3 >  ,LE.  3)  THEN 

I  ASP  < NASP *  S  >  =  I  ASP ( NASP  *  S )  +  1 
IPARM ( 1 )  *  2 
IPARM ( 2 )  =  NASP  +  10 
.  IPARM( 3)  =  NUMTK 
IF  ARM  1 4  )  =  NUMTK 

CALL  SCHED( 7, IPARM* TIME)  3  ASP 

RETURN 
ELSE 
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c  :*:*:*:* 


C**** 


GO  TO  5 
END  IF 
END  IF 

LOOK  FOR  A  SERVER  AT  THE  ASF 
NUMQ  =  IA3PCNASP,7> 

CALL  GETQUE ( NUMSRV  , NUMQ ) 

IF(NUHSRV  .ST.  0)  THEM 

SCHEDULE  THE  ASP  EVENT 
IPARM(l)  =  1 
IP  ARM  ( 2 )  =  NASP  +  10 
IPARM<3)  =  NUMTK 
IP ARM ( 4)  =  NUMSRV 
ITRUCK(NUMSRV*3)  =  4 

CALL  SuHED(7»IPARM,TIME)  I?  ASP 

RETURN 
ELSE 

I ASP (NAS?, 20)  =  I AS? « NASP » 20)  +  1  3  'NO  SERVES'  CNTR 

END  IF 

PUT  TRUCK  INTO  PROPER  QUEUE 
CALL  PUTQUE( NUMTK, NASPQ) 

RETURN 

END 
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U  U  Do  O  C— 1  O  o  O  O  CJ  O  (-'  o  O  O  C.J  O  t_>  CJ 


SUBROUTINE  ASF'CK 
SUBROUTINE  ASPCK  (IPARM) 

OX***  ASPCK  —  CHECKS  FOR  SUFFICIENT  AH NO  AT  ALTERNATE 
CALLED  BY  ASPARV 
CALLS  SCHED.  OPERA 


XXX*  L  TOLIN 


NAY  32 


XXX*  IPARM(l)  — 
XXX*  IPARM(2)  — 
XXX*  IPARH( 3)  — 
XXX*  IPARMC4)  — 


UNIT  NUMBER 
TRUCK  NUMBER 
ASP  NUMBER 

MIX  ON  TRUCK  COMING  IN  (RETNS  77 


NO  AS?  HAS 


SCHEDULES  —  ASPARV 

UNIT  TRUCK  TO  SISTER  OR  REAR  ASP  IF  PARENT  AS 
HAS  INSUFFICIENT  AMMO  -  KEEPS  UNIT  TRUCK  AT 
PARENT  ASP  IF  INSUFFICIENT  AMMO  AT 
SISTER  OR  REAR  ASPS 

INCLUDE  LOG. LIST 
DIMENSION  IPARM ( 5 ) 

INTEGER  ONHAND. DEMAND 

LOCAL  VARIABLES 

MIX  -  THE  INDEX  OF  THE  AHMO  TYPE  FROM  IMIX 
KVAL  -  FLAG  1=  ROUTINE.  4=  MLRS  QUEUE 
NASP  -  ASP  NUMBER 


C  DETERMINE  AMMO  MIX  INDEX. 

NASP  *  IPARM ( 3 )  -  10 
MIX  =  I TRUCK ( IPARM(2) .5) 

C  XXX  DETERMINE  AMMG  TYPE  (NUMAM)  FOR  ASP  ARRAY 
NUMAM  =  MIX 

I F ( M I X  ,GT  .  LPPAP. (7)  i NUMAM  =  MIX  -  LPPAR'7) 

ONHAND  =  NUMAMX3+13 
DEMAND  =  NUMAMX3+1? 

NRDSND  =  IMIX  <  MIX . NUMAM) 

NUMTK  =  IPARM ( 2 ) 

C  *X  DETERMINE  'SISTER'  ASP  NUMBER ( NSASF' > 

J  =  NASP/2 
JJ  =  J  X  2 

IF '■  NASP  .EQ.  JJ/THEN 
NSASP  =  MAS?  -1 
ELSE 

NSASP  =  NASP  +  1 
END  IF 

C  XX  IF  SISTER  ASP  HAS  BEEN  INTERDICTED.  CHECK  REAR  ASP 
C  XX  DETERMINE  IF  'SISTER'  ASP  HAS  SUFFICIENT  AMMO 
IF  :  IASP(NSASP. ONHAND)  -  IA3P ( NSASP . DEMAND )  .3F. 

I  NRDSND  .AND.  NA3PH0  .NE.  ISERV  (  6 )  >  THEN 

I ASP( NSASP. DEMAND)  =  I  ASP < NSASP . DEMAND )  ?  IMIX  <  MIX  >  NUMAM 
IPARM<  3)  =  NSASP  +  10 
DDLA  Y  »  ?0.  -  I  DA  Y  x  30. 

CALL  OPERA ( NUMTK .BDLAY.Tr AT L) 


CALL  3CHSD(5»  IPARM. DDTIME >  2  AS  PAS'.' 

C  FIND  THE  VALUE  FOR  THE  QUEUE:  1  FOR  ROUTINE.  4  FOR  MLRS 

KVAL  =  1 

IF  (  NUMAM  .  EQ .  10)  KVAL  =  4 

C  FIND  THE  QUEUE  UAIT  TIME  AND  ADD  IT  TO  TOTAL  QUEUE  TIME 

NTQUE  =  TIME  -  ITRUCK(NUMTK.S) 

JASF'(NSASP.KVAL  +  1)  =  JASP ( NSASP . KVAL+1 )  r  NTQUE 
C  IF  THIS  IS  THE  LONGEST  QUEUE  UAIT.  RECORD  IT 

IF < NTQUE. GT.JASP< NSASP. KVAL+2 ) ) JASP (NSASP .  KVAL+2)=NTQUE 
ITRUCK(NUMTK»2)  =  9 
I  TRUCK ( NUMTK  » 3 /  =  9 

I  TRUCK  (  NlJMTK .  13 )  =  ITRUCK  ( NUMTK .  13 )  +  1  0  SUMP  COUNTER  TO  RASP 
URITE ( 6* 100  > NUMTK .MIX .NASP  r  10. NSASP  +  10. TIME 
100  FORMAT ( '  UNIT  TRUCK'. 14.'  MIX' .13. '  SENT  FROM  ASP'. 13. 

Z  '  TO  SISTER  ASP'. 13.'  AT  TIME'.FS.l) 

ELSE 

C  **  DETERMINE  ‘REAR*  ASP  NUMBER (NR AS? ) 

NRASP  =  I  AS? (N ASP. 11)  -  10 

IF  ( I ASP ( NASP . 2 )  .EQ.  0  .AND.  NRASP  .GT.  0)  THFN 

IASP(NRASP. DEMAND)  =  I  ASP (NR ASP. DEM AND)  4  IMIX(MIX.NUMAM) 

IPARM13)  =  NRASP  +  10 

OIST  =  I ASP ( NASP » 1 )  -  I ASP (NRASP » 1 ) 

ITKTYP  =  ITRUCK ( NUMTK  > 1 ) 

TVLTIM  =  60.  *  DIST / 1 TYPE ( ITKTYP  .  IDA Y  +  1) 

CALL  OPERA ( NUMTK . TVLTIM. TFAIL) 

TOTIM  =  TIME  +  TVLTIM  +  TFAIL 
CALL  SCHED<5. IPARM, TOTIM)  3  ASPARV 

C  FIND  THE  VALUE  FOR  THE  QUEUE.'  1  FOR  ROUTINE.  4  FOR  MLRS 

KVAL  =  1 

IF ( NUMAM  .EQ.  10)KVAL  =  4 

C  FIND  THE  QUEUE  UAIT  TIME  AND  ADD  IT  TO  TOTAL  QUEUE  TIME 

NTQUE  =  TIME  -  ITRUCK ( NUMTK . 3 ) 

JASP ( NRASP » KVAL+ 1 )  =  JASP(NRASP.KVAL+1 )  +  NTQUE 
C  IF  THIS  IS  THE  LONGEST  QUEUE  UAIT.  RECORD  IT 

IF ( NTQUE. GT.  JASP ( NRASP. KVAL4-2 ) )  JASP  (NRASP. KVALr2)=NTQUE 
ITRUCK (NUMTK. 2)  =  ? 

ITRUCMNUMTK.3)  =  ? 

I  TRUCK (NUMTK .13)  =  ITRUCK(NUMTK. 13)  +  1  3  BUMP  CNTR  TO  RA3? 
URITE(6.400)NUMTK. MIX. NASP  +  10. NRASP  r  10. TIME 
400  FORMAT ( '  UNIT  TRUCK'. 14.'  MIX'. 13.'  SENT  FROM  ASP'. 13. 

Z  '  TO  REAR  ASP'. 13.'  AT  TIME'.FS.l) 

ELSE 

C  Kt  NO  AMMO  OF  NUMAM  RETURN 

ITRUCK ( NUMTK . 3 )  *  TIME 
IP ARM ( 4 )  =  777 

URITE(6»S00)NUMTK. MIX. NASP  +  10. TIME 
500  FORMATv'  UNIT  TRUCK'. 14.'  MIX'. 13.'  HELD  AT  ASP'. IS. 

Z  '  AT  TIME'.FS.l) 

END  IF 
END  IF 
RETURN 
END 


j*  1 


> 


j. 


SUBROUTINE  ASF'ARl 
SUBROUTINE  ASF'ARl  < I P A R M ) 

C***S  EVENT  ASPAR1  —  ARRIVAL  OF  ASP -ATF’  SIP  AT  ASP  (FROM  AT?  > 

C  TRUCK  IS  SERVICED (MAY  PICKUP  FULL  TRAIL)  AND 

C  RETURNED  TO  ATP. 

C  EVENT  TYPE  12 

C  CALLED  BY  MA INARM 

C  CALLS  IQ ,  PUT.QUE*  OPERA,  3CHED,  FINTK »  GETOUE,  INTRDK 
C 
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C  :*.*:«* 
C**x* 
ZXtti 
C***t 

c 

f* 

c 

c 

c 

c 

C**xx 

C 


C  #xx* 


IPARMU)  - 
I  F  ARM ( 2 )  - 
I FARM ( 3 )  - 
IPARM ( 4 )  - 

SCHEDULES 


-  ATP  NUMBER 

-  TRUCK  NUMBER 

-  ASP  NUMBER 

-  DIST  FROM  REAR  ASP  TO  ATP 


SCHEDULES  ASPARl ( ITSELF ) 

ASPAR2,  EMPTY  CSA  SiP  BACK 
ATPAR2,  ATP  SXP  BACK 
UNTARV*  SERVER  RETURN 
SCHEDULED  BY  ASPARl,  ATPAR2 ,  SERVER 
CHECKS  —  DELAY  DUE  TO  MTBF  AND  INTERDICTION 

INCLUDE  LOG, LIST 
DIMENSION  IPARM(5) » IIPARM<5) 

INTEGER  ONHAND, DEMAND, ONUAY, AVAIL 
DO  1  I  *  1,5 
IIPARM(I)  =  0 
CONTINUE 

LOCAL  VARIABLES  DEFINITION 

MIX  -  AMMO  ON  TRUCK  INDEX  TO  IMIX 

NUMAM  -  AMMO  TYPE 

TVLTIM  -  TRAVEL  TIME  TO  ATP 

ITKTY?  -  TRUCK  TYPE 

’FAIL  -  TIME  LOST  DUE  TO  TRUCK  FAILURE 
TMIND  -TIME  LOST  DUE  TO  INTERDICTION 
TMLD  -  TIME  TO  LOAD  AMMO  AT  ASP 
TOTIM  -  TIME  OF  ARRIVAL  AT  REAR  ASP 
TOTTIM  -  TIME  OF  ARRIVAL  AT  ATP 
HITI  -  HITCH  TIME 


NATP  =  IPARM<1> 

NUMSP  =  IPARMU) 

HASP  =  IPARMU )  -  10 
RDIST  =  IPARM ( 4 ) 


3  ,3T.  0  IF  FROM  FORWARD  ASF 


0  *  * 


■FLAG  =  0 
NEGSVR  =  0 
TDELAY  =  0. 

TLOAD  =  0. 

HITI  =0.  3  UNHITCH/HITCH  TIME 

FIND  AMMO  MIX  INDEX  ON  THE  TRUCK  -  MIX 
MIX  =  I  TRUCK! NUMSP, 5) 

*  DETERMINE  AMMO  TYPE ( NUMAM ) 


r>  o 


NRDSND  =  IMIX' MIX*NUMAM) 

C  SET  ITRUCK(N,3>-  equal  to  the  time  of  queue  entry,  this 

C  ALLOW  QUEUE  WAIT  TIME  TO  BE  FOUND  FOR  THE  TRUCK 

ITR'UCK  ( NUMSP ,  3 )  =  TIME 
C  *  *  I  CHECK  FOR  SUFFICIENT  AMMUNITION 
ONHAND  =  NUMAM  *  3  +  IS 
DEMAND  =  NUMAM  *3+1? 

ONWAY  =  NUMAM  *3+20 

AVAIL  =  IASP(NASP, ONHAND)  -  IASP ( NASP , DEMAND ) 

Ir ( AVAIL  .LT.  NRDSND ) THEN 

KRASP  =  IASP ( NASP ,11)  -  10  2  REAR  ASP  t 

IF( IASP(KRASP, ONHAND)  -  IASP' KRASP • DEMAND >  + 

$  IASP ( KRASP , ONWAY )  .LT.  NRDSND) THEN 
CALL  PUTQUE( NUHSP »IQ(11,NASP) ) 

I  ASP ( NASP • DEMAND )  =  IAS?<NASP, DEMAND)  +  NRDSND 
WRITE ( a » 25  5 NUMSP , MI  X , NASP+ 10 , TIME 
23  FORMAT''  ATP  S*P',I3»'  MIX',  13,'  KEPT  AT  ASP', 13, 

$  '  AT  TIME' ,F3.1) 

RETURN 
END  IF 

C  *  *  *  SCHEDULE  ASPAR1  TO  REAR  ASP 

I P  A  R  M  ( 3 )  =  KRASP  +  10 
ITRUCK ( NUMSP , 3 )  =  5 
DIST  =  IASP(NASP» 1 )  -  IASP ( KRASP , 1 ) 

ITKTYP  =  ITRUCKCNUMSP, 1 ) 

TVLTIM  =  60.  *  DIST  /  ITYPE( ITKTYP, IDAY+3 ) 

CALL  OPESA(NUMSP, TVLTIM, TFAIL) 

TOTIM  =  TIME  +  TVLTIM  +  TFAIL 
IPARM ( 4 )  «  DIST  +  IATP<NATP»2) 

CALL  SCHEDU2,  IPARM. TOTTM)  3  ASPAR1 

ITRUCK ( NUMSP ,14)  =  ITRUCK ( NUMSP ,  14)  +  1  2  INCREMENT  *  BUMPS  TO  RASP 

WRITE (6, 35) NUMSP, MIX, NASP +10, KRASP +10, TIME 
35  FORMAT ( '  ATP  SSP',15,'  MIX', 13,'  BUMPED  FROM  ASP', 13, 
i  '  TO  REAR  ASP', 13,'  AT  TIME',F8.1) 

RETURN 
END  IF 

*  *  *  SEARCH  FOR  FULL  S  S  P 
NASPQ  =  IQ(7,NASP) 

CALL  FINTK ( NASPQ, MIX, NCSA SP , 1 ) 

IF  ( NCSASP  .EG.  0)30  TO  40 

0  *  IF  .GE. ,HAVE  FOUND  FULL  C3A  S  i  ?— ASSUME  SWAP  IN  30  MIN 
IF  t ITRUCK(NCSA3P,6>  .5E.  10000)THEN 
I  TRUCK (NCSASP, 6)  =  0 
I IPARM ( 1 )  =  NASP  +  10 
I IPARM (2 )  =  NCSASP 
I IPARM( 3)  =  0 
I IPARM ( 4 )  *  555 

CALL  SCHED (13, II FARM, TIME  +  30.)  3  ASFAR2 

C  *  NOW  SCHED  ASP-ATP  S  S  P  TO  ATP 
H I T I  -  30. 

ITRUCK (NUMSP, 11)  =  ITRUCK ( NUMSP >  11 )  +  1  2  INCREMENT  THRUFUT 
NEGSVR  =  1 
30  TO  SO 


+  1  3  INCREMENT  THRUFUT 


PARTIAL  OS  NO  LOAD  ON  CSA  3  S  ?.  TRY  TO  FIND  SERVER 
NSVRQ  =  I ASP  ( NASP • 7  5 
CALL  GETQUE (  NUMSVR . NSVRG ) 

IF ( NUMSVR  .30.  O.THEN  3  NO  SERVES  QUEUE 

IF ( NCSASP  .HE.  0 i CALL  PUTQUE ( NCSASP > NASPQ ; 

CALL  F"JTQUE(  HUMS? .  IQ(  1 1 » NASP )  > 

RETURN 

ELSE 

UASP ( NASP » 7 )  =  JASP  ( NASP » 7 )  r  1  3  INCREMENT  *  ’SERVED 

I  TRUCK ( NUMSVR » 3 )  =  4 
IF  (NCSAS?  .EG.  0 ;  GO  TO  TO¬ 
GO  TO  55 
END  IF 
END  IF 

ERVES  AVAILABLE— SEE  IF  ANOTHER  SIP  HAS  AMMO  TYPE  NEEDED 
CALL  FINTK ( NASPQ . NUMAM . NCSASP » 0 ) 

IF  NO  TRUCK.  50  TO  GRNO  LOAD 
IF ( NCSASP  ,EQ.  0)  GO  TO  70 

FIND  THE  NUMBER  OF  ROUNDS  ON  NCSASP.  IF  SUFFICIENT  *  DECREMEN 
AMMO.  SCHEDULE  UNTARV.  PUT  TRUCK  RACK  IN  ASP  Q. 

IF  INSUFFICIENT.  EMPTY  3SP  TRUCK. SEND  TO  CSA,  DECREMENT 
THE  NUMBER  OF  ROUNDS  REQUIRED.  FIND  ANOTHER  TRUCK  WITH 
PROPER  AMMG  OR  COMPLETE  LOADING  FROM  STOCK. 

UPDATE  PER  CENT  ROUNDS  ON  THE  TRUCK. 

NRONTK  =  ( I MIX (MIX .NUMAM) *1  TRUCK ( NCSASP. a) +99?? ) / 10000 
ITRUCK(NUMSVR.13)  =  ITRUCK<NUMSVR» 12)  +  1  3  LOAD  FROM  CSA  SiF 
IF  INSUFFICIENT  ROUNDS  30  TO  60 
IF ( NF:DSND  ,8T.  NRONTK)  GO  TO  60 

SUFFICIENT  AMMO  ON  TRUCK.  DECREMENT  AMMO  ON  TRUCK 
I  TRUCK! NCSASP .3;  =  1000C*(NRONTK  -  NRDSND>/IMIX(MIX.NUMAH> 

IF-. I  TRUCK  (NCSAS?.  6  >  .EQ.  0)  30  TO  SO 
IF  ■;  I  FLAG  .EQ.  1 )  THEN 
RMDS  =  NRDSND 
PNDAV  *  FRNN 

TDELAY  =  TDELAY  +  IMIX(MIX.32>  *  ( RNDS/RNDAV  • 
ti  cr 

Wte 

TDELAY  =  IMIX(MIX.32> 

END  IF 

SCHEDULE  RELEASE  OF  3  1  P 
IIPARM(l)  =  NASP  +  10 
I IPARM ! 2 )  *  NCSAS? 

I  IPAF'M'.  35  =  0 
II? ARM ( 4 ;  *  999 

CALL  SCHED! 13 » I IPARM. TIME  +  TDELAY)  3  ASPAR2 

GO  TO  30 

INSUFFICIENT  AMMO  OR  EXACTLY  ENOUGH  AMMO  ON  SIP 
TIME  TO  SHIFT  PARTIAL  LOAD 
FRNN*  NRDSND 

TLOAD  *  IMIX(MIX.32>  *  NRONTK  /  FRNN 
IF  (IDAY  .EQ.  0)  TLOAD  =  1.54*TL0AD 
TDELAY  =  TDELAY  +  TLOAD  +5.0 
NRDSND  *  NRDSND  -  NRONTK 
I  TRUCK (NCSASP. a)  =  0 


SERVING  SiR  EMR1 


II?ARM<2>  =  NCSAS? 

IIRARh'3)  =  0 
II?ARM(4>  =  535 

CALL  SCHED ( 13 . 1 IP ARM  >  TIME  +  TDELAY)  3  ASFAS2 

IFLAG  =  1 

IF  EXACTLY  ENOUGH  ROUNDS  ON  TRUCK.  SEND  BACK  TO  UNIT 
IF(NRDSND  .EQ.  0)  GO  TO  30  3  RTN .  SERVING  SSR 

GO  GET  ANOTHER  5SR  TRUCK  TO  COMPLETE  THE  LOAD 
OR  COMPLETE  FROM  ON  THE  GROUND  STOCK 
GO  TO  50 
NRST  =  NRDSND 

TTLOAD  =  TLQAD  P  ( IMIX(MIX»32> >*(NRST  /  IMIX < MIX . NUMAM ) > 

IF  (IDAY  . E3 *  0)  TTLOAD  =  1.54*TTL3A0 
TDELAY  =  TDELAY  P  TTLOAD 
*  DECREMENT  ASP  AMMO 

I  ASP ( NA3P .ONHAND )  =  lASP(NASP.ONHAND)  -  NRDSND 
INCREMENT  AMMO  USED  FROM  ASP 
I  ASP AM ( NASP . M IX )  =  IASPAM < NAS?  .MIX >  P  1 
INCREMENT  ROUNDS  ON-THE-WAY  TO  ATP 

I  ATF'(  NATP.  ONHAND+2)  =  IATP<NATP.0NHAND  +  2  .  P  IMIX (MIX. NUMAM) 
SCHEDULE  ATRAR2 1  COMPUTE  NECESSARY  PARAMETERS 
ITKTYP  =  I  TRUCK ( HUMS? » 1 ) 


I  Mi  I X  (  MIX .  NUMAM ) ) 


-  NRDSND 


TVLTIM  =  60.  *  IATP(NATP»2)  /  ITYPE( ITKTYP. IDAY+2) 

IF < RDIST  ,GT .  0 . ) TVLTIM  =  60.  *  RDIST  /  ITYPEC ITKTYP. IDAY  +  3) 
IPARMM)  =  MIX 

NTIQ  •=  TIME  -  ITRUCK(NUMSP»3) 

ITRUCK(NUMSP»12>  =  ITR'JCK  (NUMSP*  12)  +  NTIQ  3  TRUCK  TIME  IN  QUEUE 

I TRUCK (NUMSP.  13)  =  ITRUCK(NUHSP* 13)  +  1  3  *  *  3  ASP 

JASP(NASP.8)  *  JASP(NASP.S)  P  NTIQ 

I F < NTIQ  .ST.  JA3? ( NASP » ? ) > JASP ( NASP » 9 )  =  NTIQ 

ITRUCK ( NUMSP . 3 )  =  4 

COMPUTE  INTERDICTION  TIME  LOST 

CALL  INTRBK ( NUMSP » TMIND ) 

IFtTMIND  .LE.  0.)  THEN 

COMPUTE  TIME  LOST  DUE  TO  TRUCK  FAILURE 
CALL  OPERA ( NUMSP • TVLTIM. TFAIL) 


TFAIL  =  0. 

END  IF 

CONSIDER  LOAD  TIME  AT  ASP  WHICH  MIGHT  BE  ZERO 
TMLD  =  !MIX<MIX.32> 

*:*:**  IF  NO  INTERDICTION.  BYPASS 
IF (TMIND  .GT,  0.)  THEN 

***:«  DECREMENT  AMMO  AGAIN  SINCE  LOST  A  TRUCK  LOAD 

IASP(NASP. ONHAND;  =  IASP ( NASP . ONHAND )  -  NRDSND 
IASPAM (NASP .MIX )  =  I  ASP AM ( NASP . M IX )  P  1 
****  ADD  ANOTHER  LOAD  TIME 
TMIND  =  TMIND  P  TMLD 
END  IF 

SCHEDULE  ARRIVAL  AT  ATP  AT  TIME  TOTTIM 

TOTTIM  =  TIME  P  TVLTIM  P  TMIND  P  TFAIL  P  TMLD  P  Hi 

I  TRUCK (NUMSP. a)  =  10000 

CALL  SCHEDdl.IPARM. TOTTIM)  3  ATPAR2 


IF C  MEGS VR  .£0.  1 ) RETURN 
CALL  OPERA  <  NUMSUR » TMLD »  TFAIL ) 

SVRTI  =  TIME  +  TMLD  -r  TFAIL 
IPARM(l)  =  NASP  +  10 
IP ARM' 2)  =  NUttSVR 
IP  ARM'.  3)  =  1 
IPARM <  4 )  =  0 

CALL  SCHED<8» IPARM.SURTI)  3  UNTAR1.1 

ITRUCK ( NUMSVR » 10 ;  =  ITRUCK'NUMSVRf 10)  +  1  3  ATP-ASP  SIP 
I  TRUCK  ( NliMSVR > 6 )  =  ITRUCK(NUMSVR»6>  +  I  NT 'TMLD) 

RETURN 


SUBROUTINE  ASPAR2 
SUBROUTINE  ASPAR2  (IPARM) 

Ztttt  EVENT  ASPAR2  —  ARRIVAL  OF  SIP  TRUCK  AT  ASP  FROM  C3A 
C  HAY  SWITCH  TRAIL  WITH  ATP  SIP 

C  EVENT  TYPE  13 

C  CALLED  BY  HA  INARM 

C  CALLS  PUTQUE*  GETQUE*  OPERA >  INTRDK >  SCHED*  Id;  SERVER 

C ttti  D.  REMEN  SEP  80 

C**»*  IPARM(l)  —  ASP  NUMBER 

CUt*  IPARM<2)  —  TRUCK  NUMBER 

C**»*  IP  ARM  ( 3 )  — 

CUtt  IPARM ( 4 )  —  535:  3  I  P  IS  EMPTY  ???:  PARTIAL  LOAD  RETURN 

C  444t  ARRIVAL  FROM  DAO 

C****  SCHEDULES  --  CSAARV.  ARRIVAL  OF  SIP  TRUCK  AT  CSA 
C  ASPAR2 ,  RETURN  OF  EMPTY  ASP  SIP 

C  ATPAR2 ,  RETURN  OF  EMPTY  ATP  SIP 

C  SCHEDULED  BY  ASF*  ASPAR1 >  ASPAR2,  ATPARl *  C3ADEP r  SERVER «  ATPA 
C 

Ctttt  CHECKS  —  DELAY  DUE  TO  MTBF  AND  INTERDICTION 
C  NOTE*.  EACH  TRACTOR  HAS  TWO  TRAILERS'  ASP  SIP  TRACTORS  STAY 

C  -  WITH  THE  EMPTY  TRAILER.  (ATP  TRACTORS  STAY  WITH  THE 

C  TRAILER). 

C 

INCLUDE  LOG, LIST 

DIMENSION  IPARM<5> ,  ISPQ< 10) *  I I?ARM<5 > 

INTEGER  ONHAND 

p 

cm*  LOCAL  variables: 

cm*  MIX  —  AMMO  MIX  NUMBER  ON  TRUCK 

cm*  DIST  —  BIST  TO  ASP  OR  CSA 

C*m  TVLTIM  —  TRAVEL  TIME 

Ctttt  ITKTYP  —  TRUCK  TYPE 

CUtt  TFAIL  —  DELAY  ENROUTE  DUE  TO  FAILURE 

Cm*  TGTIN  —  TIME  OF  ARRIVAL  OF  TRUCK  AT  ASP  OR  CSA 

CUU  TMIND  —  INTERDICTION  TIME  DELAY 

C*m  INDEX  —  NUMBER  OF  QUEUE  FOR  CSA  -  ASP  TRUCK 

cm*  IND  —  INDEX  FOR  AMMO  INVENTORY  CONTROL  IN  IASP 

Ctttt  ISPQO  —  SIP  NUMBERS  FROM  QUEUE  TO  FORM  A  CONVOY 

n 

NASP  =  I?ARM<  D-10 
NUMSP  =  IPARM ( 2 ) 

I3TAT  =  IPARMi 4) 

Cm*  FIND  THE  MIX  ON  THE  TRUCK 
MIX  =  ITRUCK ( NUMSP , 5 ) 

IF (MIX  ,LE.  0>  THEN 
WRITE ( a , 1 )  NUMSP 

1  FORMAT ( '  ASPAR2  —  ZERO  MIX  ON  TRUCK  '*14) 

RETURN 
END  IF 


I0UT»0 

:********m**LOOK  FOR  OFFLOADED  SIP  RETURNING 
IF(ISTAT.EQ.555)THEN 


3-  1? 


n  o 


IAS? ' NAS?  *  3  >  =  IA3P ( NAS? . 3 )+i 
CALL  PUTQUE ( NUMSP . I ASP ' NAS? .  4 )  > 
ITRUCK  ( NUMSP » 3 )  =  TIMS 
END  IF 

IFCISTAT  .Ed.  99?) THEN 

CALL  PUTQUE ( NUMSP 1 1 ASP ( NASP » 4 ) ) 
RETURN 
END  IF 


:m*****:K**CHECK  FOR  EMPTY  SIP  TO  RETURN  TO  CSA  IN  CGNUQY 
IF ( I ASP <  NASP*  6 ) . GE. 7) THEN 
DC  3  I  =  1*10 
I3P9( I )  =  0 
2  CONTINUE 

CALL  S£TGUE(NUMSP* IASP(NASP»4> ) 

K0UNT»1 

IF( NUMSP. £0.0) RETURN 
NCHKSP=NUMSP 

CALL  PUTQUE(NCKKSP» IASP(NASPt 4 ) ) 

13.  CALL  GETQUE<  NUMSP  *  I  ASP  ( NASP » 4 ) ) 

IF( I TRUCK ( NUMSP *6>.EQ.0> THEN 
ISPQ ( KOUNT ) =NUMSP 
IF (NUMSP. £Q.NCHKSP)60  TO  11 
IF(KOUNT  ,EQ.  7) GO  TO  11 
KOUNTsKQUNT  4  1 
GO  TO  13 
ELSE 

CALL  PUTQUE  <  NUMSP , I  ASP ( NASP » 4 ) ) 
IF(NUMSP.EQ.NCHK3P)G0  TO  11 
GO  TO  13 
END  IF 
C 

C*****m*HAVE  ALL  THE  EMPTY  TRAILERS* r IND  DISTANCE  AND  3CHF 
11  D I ST® I ASP ( NASP > 1 ) 

ITKTYP»ITRUCK<NUMSP* 1) 

TULTIM*oO. *DIST/ITYPE( ITKTYP* IDAY+3 ) 

TS*1 . 

DO  12  JJ*1 * KOUNT 
NUMSP  *  ISPQ(JJ) 

NOTI  *  TIME  -  I TRUCK ( NUMSP * 3 ) 

I  TRUCK (NUMSP* 12)  =  ITRUCK(NUMSP* 13)+  NQTI 
I  TRUCK ( NUMSP  *14)  =  I TRUCK ' NUMSP , 1 4 >  +  1  3  *  TTM 

I  TRUCK (NUMSP *3)  =  4 
CALL  INTRDKl NUMSP » THI.NB ) 

IF ( TMIND  .LE.  0.)  THEN 

CALL  OPERA (NUMSP » TVLTIM * TF AIL ) 

ELSE 

TFAIL  s  u, 

END  IF 

totim=tvltim+time+tfail+tm:nd+ts 

I IP ARM ( 1)=NASP+10 
I  IF’ARM(  2 )  sNUMSP 
IIPARM(3)=0 
I  IP ARM { 4  )  a  0 


3-  20 


I ASP  <  NAS? . 6  >  a I AS? ( NAS?  >  s  > - 1 
12  CONTINUE 

END  IF 

IF (IOUT.EQ. 555) RETURN 
C 

C  *  K  *  INCREMENT  AMMO  ON  HAND  AT  THIS  ASP/  DECS  ON-  —MAY 
NUMAM  a  MIX  -  LPF'ARO ) 

ONHAND  =  NUMAM  *  3  +  13 

I ASP ( NASP } QNHANO )  *  I ASP < NASP » ONHAND )  +  • IMIX £  MIX » NUMAM ) 

Z  *  ITRUCK < NUMSP « 6 )  +  9999)  /  10000 
I  ASP ( NASP  t ONHAND  +  2 )  =  I  ASP < NASP t ONHAND+2 )  -  ( IMIX (MIX t NUMAM ) 

Z  t  ITRUCK  (NUMSP  .6)  4-  9999)  /  10000 
IC3TYP  =  NUMAM 
r 

C  *  *  *  *  ARRIVAL  COUNTERS 

I ASPSP ( NASP  t NUMAM )  =  I ASPSP C NASP > NUMAM ;  +  1 
IF  (ISTAT  ,EQ.  444 )  THEN 

ITRUCK  ( NUMSP » 1 1 )  =  ITRUCK < NUMSP *  1 1 >  4-131  ARRIVALS  FROM  DAO 
I ASPAM( NASP »  70  +  ICSTYP )  a  IASPAM(NASF.70+ICSTYP  ;  +  1 
ELSE 

ITRUCK ( NUMSP » 10)  =  ITRUCK(NUMSP» 10)  +13*  ARSIUIAL3  FROM  CSA 
IA3PAM(NASPf90+ICSTYP)  =  lASPAM'NASPr 90+ICSTYP)  +  1 
END  IF 

C -K-t4C.lt  UPDATE  TRUCK  STATUS  TO  THE  CSA-ASP  QUEUE 
I  TRUCK (NUMSP >3) *  3 

Ctt  LOOK  FOR  ASP-ATP  SIP  OF  SAME  MIX 
IFdCSTYP  .ST.  10)  GO  TO  30 
NATPQ  =  IQ ( 11 » NAS?) 

CALL  GETQUE ( NATPSPf NATPQ ) 

IF CNATPSP  .£3,  0 ) GO  TO  30 

IATPCK  =  NATPSP 

CALL  PUTQUE (NATPSP »NAT*Q) 

40  CALL  GETQUE (NATPSP » NATPQ ) 

MIXX  =  ITRUCK ( NATPSP »5> 

IATPTY  =  MIXX  -  LPPAR(S) 

IF  ( ICSTYP  ,EQ.  IATPTY)  GO  TO  ’70 
CALL  PUTQUE (NATPSP. NATPQ) 

IF( IATPCK  .EQ.  NATPSP)  GO  TO  30 
GO  TO  40 

CK:*  HAVE  FOUND  ASP-ATP  SIP  UITH  SAME  AMMO  TYPE 5 
C**  SWAP  LOAD  FROM  CSA  TO  ATP  SIP 
CK*  SCHEDULE  RELEASE  OF  CSA  SIP 
70  I  TRUCK (NUMSP. 6)  =  0 
IPARM( 4)  =  555 

C  iL  3CHED(l3»I?ARM»TIME+30. )  3  ASPAR2 

C**  SCHEDULE  ASP-ATP  SIP  TO  ATP 

MAT?  a  ITRUCK ( NATPSP » 4)  -  73 
IPARM(l)  =  NATP 

[Farm (2)  =  natpsp 

IPARM( 3)  =  NASP 
I  FARM ( 4 )  a  0 
DI3T  =  IATP(NATP»2! 

I7KTYP  =  ITRUCK ( NATPSP > 1 ) 


C.J  c> 


CALL  INTRDK( NATPSP jTMIND) 

IF ( TMIND  .LE .  0.)  THEM 

CALL  OPERA ( NATPSP < TVLTIM »  TFAIL ) 

Cl  cc 

'—WWW 

TFAIL  =  0. 

END  IF 

TQTIM  =  TIME  +  TVLTIM  +  TFAIL  +  TMIND  +  30.  3  30  MIN  UNH/H  TI 
CALL  SCHEIKllr IPARMf FOTIM)  9  ATPAR2 

NTIQ  -  TIME  -  ITRUCK(NA7PSP,3> 

JASP ( NASP  r  3 )  =  JASP ( NASP » 3 )  +  NTIQ 

IF  (NTIQ  .ST.  JASP  ( NASP » 9) JASP  (NAS?,?!  =  NTIQ 

ITRUCK ( NATPSP » 12)  =  ITRUCK ( NATPSP » 12)  +  NTIQ 

ITRUCK ( NATPSP *113  =  ITRUCKvNATPSP* 1 1 )  +  1  9  THRU  PUT  COUNTER 

p 

ITRUCK(NATPSP*3)  =  4 
ITRUCK (NATPSP *6)  =  10000 

JASP (NASP *7)  =  JASP(NA3?*7)  +  1  3  INCREMENT  ARP-A7?  TRUCKS  SFRV 

r 

w 

IASPAM (NASP  *  60+ICSTYP )  =  IASPAM(NASP»60+ICSTYP)  +13*  SERVED 
IAS? ( NASP »ONH AND)  =  IAS?(NASP»ONHAND>  -  IMIX(MIXX,  IATPTY) 

C  DEMAND  =  ONHAND  +  1 

IASP(NASP*0NHAND+1)  =  IASP(NASP,GNHAND+1)  -  IKIX(MIXX> IATPTY' 

r* 

w 

RETURN 

Cm«*«*PUT  OTHER  TRUCKS  INTO  THE  QU£ 

30  INDEX  =  IQ(7,NASP) 

CALL  PUTQUE'NUMSP* INDEX) 


#***  IF  SERVER  AVAILABLE *  OFF-LOAD  ARRIVING  CSA  SIP 
IQSVR  =  IASP(NASP>7) 

CALL  SETQUE ( NUMSVR * IQSVR ) 

IF ( NUMSVR  .GT,  0)THEN 
IPARM(2)  =  NUMSVR 
IP ARM (3)  =  1 
CALL  SERVER ( IPARM ) 

END  IF 
RETURN 
END 


o  o  o  o  o  o  o  ci  ci  a  ci  c.  o  n  o  o  o  o  o  o  o  c*>  o  a  a  o  c>  <->  rv  c  m  o  o  o  a  ci  o  c~,  o  ct  o  o 
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SUBROUTINE  ATP 
SUBROUTINE  ATP  (I? ARM) 

C*m  EUENT  ATP  —  SERVICE  OF  TRUCK  FROM  QUEUE  AT  AT 
C  LOADS  OFF  SiF'IUSE  FORKLIFT/CRAIN) 

C  EVENT  TYPE  6 

C  CALLED  BY  MAINARM 

C  CALLS  IQ*  FINTK*  SCHED*  OPERA*  LBPWOR (FOR 
C 

****  J.  FOX  JAN  7? 


OR  OFF  THE  GROUND • 

ARTY)*  INTRDK 


:m*  IPARH<1)  — 
.«***  IF  ARM  <  2  -- 

m*  !PARM<3>  — 
XXXX  I P A R M <  4 )  — 
SCHEDULES 


SCHEDULED  BY 


1  =  ARTILLERY  QUEUE*  2  =  MANUEVER 

ATP  NUMBER 

UNIT  TRUCK  NUMBER 

SERVER  NUMBER 

ASPARV,  FOR  INTRDKED  UNIT  TRUCKS 
ATPAR1,  C3A  SSP  ->  ATP 
ATPARV*  RESCHEDULE  ATP  EVENT 
UNTARV *  SERVER  OR  UNIT  TRUCK  RETURNS 
ATPAK2*  ASP  S4P  ->  AT? 

ATPARV*  DEPASP*  SERVER 


QUEUE 


SSS*  NOTE  ! ! !  IN  THIS  ROUTINE  NUMTK(N.S)  CONTIANS  THE  TIME  THE 
TRUCK  ENTERED  THE  QUEUE  1 


(1)  TAKES  TRUCK  OUT  OF  ITS  QUEUE 

(2)  CALCULATES  LOAD  TIME  AS  FUNCTION  OF  LOAD  MIX 
NUMBER  AND  NUMBER  OF  SERVERS  ACTIVE  FOR  THIS  QUEUE. 

*m  CHECKS  --  DELAY  IN  ARRIVAL  DUE  TO  MTBF  AND  INTERDICTION. 

INCLUDE  LOG.LIST 

DIMENSION  IPARN',5)*  IIPARM'.S) 

LOCAL  VARIABLE  DEFINITION 
NUMTK  -  TRUCK  TO  BE  SERVED 
MIX  -  INDEX  OF  AMMO  MIX  ON  TRUCK 

NRNDSN  -  NUMBER  OF  ROUNDS  NEEDED  BY  THE  TRUCK  NUMTK 
NUMAM  -  TYPE  OF  ROUNDS  NFEDED  BY  NUMTK 
NATP  -  ATP  NUMBER 

MR NO  -  NUMBER  OF  POWDER  CHARGES  NEEDED 
NATPQ  —  NUMBER  OF  THE  ASP<->ATP  TRUCK  QUEUE 
NUMSP  -  NUMBER  OF  ASP  ATP  TRUCK 
NR0N3P  -  NUMBER  OF  ROUNDS  ON  SUPPLY  SSP 
MI XX  -  MIX  INDEX  OF  AMMO  ON  SUPPLY  SSP 
BIST  -  ROAD  HIST  TO  BE  TRAVELED 
TVLTIM  -  ROAD  TRAVEL  TIME 
TFAIL  -  TIME  DELAY  DUE  TO  FAILURE 
TMINO  -  TIME  DELAY  DUE  TO  INTERDICTION 
TOTTIM  -  TIME  TO  SCHEDULE  ATP  OR  ASP  ARRIVAL 
TPAR  -  TIME  REQUIRED  TQ  SHIFT  A  PARTIAL  LOAD 
ETIME  -  DELAY  TIME  FOR  ATPARV 
C  DTImS  -  DELAY  TIME  FOR  UNTARV 
:j  FSNN  -  REAL  VARIABLE  FOR  NUMBER  OF  ROUNDS  NEEDED 
::  TlOAD  -  LOAD  TIME 


LUrfi.1  =  V. 

TDELAY  =  0. 

I  FLAG  =  0. 

TTDEL  =  0. 

IQTYPE  =  IP ARM ( 1 ) 
NATP  =  IPARM(2) 
NUMTK  =  IF'ARM  (  3 ) 
NUMSVR  =  IP ARM ( 4  > 
I  FARM ( 3)  =  0 
IPARMU)  =  0 


DO  1  I  =1.5 

1 1  FARM  ( I >  =  0 
1  CONTINUE 

FIND  THE  QUEUE  WAIT  TIME  AND  ADD  IT  TO  TOTAL  QUEUE  WAIT  TIM 
NTQUE  =  TIME  -  ITR'JCK<NUMTK.3> 

ITRUCK (NUMTK. 12 )  =  ITRUCK < NUMTK. 12)  +  NTQUE 

JATP  < NATP » KUAL+1 )  =  JATP l NATP .KUAL+1 )  +  NTQUE 

IF  THIS  IS  THE  LARGEST  WAIT,  STORE  IT 

IF ( NTQUE. GT. JATP ( NATP. KUAL+2 > )  JATP ( NATP »KVAL+2)=NTQUE 

IF( I  TRUCK ( NUMTK . 6 )  .GT.  0) TTDEL  =  15. 

FIND  AMMO  MIX  INDEX  OF  TRUCK  MIX 
MIX  =  ITRUCK(NUMTK.S) 

FIND  AMMO  TYPE  WANTED.  ASSUME  ONLY  ONE  TYPE 
NUMAM  =  MIX 

IFCMIX  .GT.  LPPAR<7) )NUMAM  *  MIX  -  LPPAR<7> 

RECORD  NUMBER  OF  ROUNDS  NEEDED  -  NRNDSN 

NRNDSN  =  I M IX ( MIX. NUMAM) - ( ( I TRUCK ( NUMTK » 6  5 II MIX (M IX. NUMAM )  + 
Z  9999 ) / 10000 ) 

NOW  TO  LOCATE  SIP  CONTAINING  PROPER  TYPE  OF  AMMO 
FIRST  CHECK  CSA  S  S  PS.  PASS  AMMO  AND  QUEUE  TO  CHECK. 

NATPQ  =  IQ(  IATPSD<2) .NATP) 

130  CALL  F I NTK ( NATPQ » NUMAM » NUMSP » 0 ) 

IF (NUMSP  .EQ.  0 ) THEN 

NO  CSA  TRUCK  SO  TRY  ASP-AT?  TRUCK 
****  IF  HAVE  LQGKED  AT  ASP  QUEUE.  THERE  IS  NO  AMMO  GG  TO  142. 
IF ( NATPQ. EQ. IQ< IATPSD<3) .NATP) )  GO  TO  142 
MATF'9=IQ(  IATF'SD(3)  .NATP) 

GO  TO  130 
****  WRITE  FLAG 

142  WRITE (6. 141)  NATP. NUMAM. TIME 

141  FORMAT ( '  ATP  '.12.'  SIPS  BUSY  FOR  AMMO  '.12.'  AT  TIME  - 
WRITE  (L'JQUT.  141)  NATP.  NUMAM.  TIME 
IPARMU)  =  ITRUCK  (NUMTK.  4) 

IPARM( 2)  *  NUMTK 
IPARMI3)  =  NATP 
I P  A  R  M ( 4 )  =  999 
ETIME  =  TIME 

:F(ITRUCK(NUMTK.o)  .IE.  05ETIME  =  ETIME  ?  13. 

CALL  SCHED(4.IPARM. ETIME  +  TDELAY  +  TTDEL)  3 

IF (NUMAM  .EQ.  10) THEN 
I IP ARM < 1 )  =  NATP 
I  IF'AF'M (  2 )  =  -1 


3  U  N 


CALL  SCHEDO.IIPARM.ETIMf  +  T DELAY ) 
RETURN 


TARU 


END  IF 

ITRUCK ( NUHSVR  ,  3 )  =  4 

CALL  OPERA (NUMSUR.TLOAD.TFAIL) 

DTI  ME  =  TIME  +  TLOAD  +  TFAIL 
IPARHd)  =  NATP 
IPARM (2)  =  NUMSUR 
IPARHd)  =  0 
IPARM < 4 )  =  0 

CALL  3CH£D( 3.  IP  ARM » DTI  ME)  3  UNTARU 

RETURN 
END  IF 

C  FIND  THE  NUMBER  OF  ROUNDS  ON  NUMSP.  IF  SUFFICIENT.  DECREMENT 
C  AMMO.  SCHEDULE  UNTARU.  PUT  S  2  P  BACK  IN  ASP  Q. 

C  IF  INSUFFICIENT  EMPTY  CSA  S  1  P»  SEND  TO  C3A.  DECREMENT 

C  THE  NUMBER  OF  ROUNDS  REQUIRED.  FIND  ANOTHER  3  2  P  WITH 
C  THE  PROPER  AMMO 

C  UPDATE  PER  CENT  ROUNDS  ON  THE  3  2  P 
MIXX  =  ITRUCK (NUMSP. 5) 

NRONSP  *< IM I X(MIXX.NUMAM)* ITRUCK (NUMSP. 6) +9999) /I OOOO 
WRITE (LUOUT, 300) MIX, MIXX. NUMAM, NRNDSN. NUMTK, NRONSP .NUMSP, NATPQ 
300  FORMAT ( '  I AT?  ' ,816) 

C  IF  INSUFFICIENT  ROUNDS  GO  TO  150 
IF (NRNDSN  ,ST.  NRONSP)GO  TO  150 
C  SUFFICIENT  AMMO  ON  S  \  P .  DECREMENT  AMMO  ON  S  I  P . 

C  IF  ARTY  AMMO  GO  LOAD  POWDER 

NRND  *  IMIX(MIX.NUMAM) 

IF (NUMAM.3T , 2. AND. NUMAM. LE. 7) CALL  LDPWDR (NRND, IPARM, NUMAM) 

ITRUCK ( NUMSP » 3)  =  10000  *  (NRONSP  -  NRNDSN)  /  IMIXtMIXX, NUMAM) 

C  SCHEDULE  RELEASE  OF  5  2  P  (SCHED  ATPAR1  OR  2) 

IF< IFLA6  «EQ . 1 ) THEN 

TDELAY  =  TDELAY  +  IMIX(MIX,3D  *  ( NRNDSN/FRNN ) 

ELSE 

IF (NUMAM  .GT.  3  .AND.  NUMAM  .IE.  7) THEN 
TDELAY  =  (IMIX(MIX,3l)/2) 

ELSE 

TDELAY  =  IMIX( MIX ,31 ) 

END  IF 
END  IF 

135  I IPARM ( 1 )  =  NATP 
I IPAPM ( 2 )  =  NUMSP 
II?ARM( 4)  =  555 

IFdDAY  .EQ.  0) TDELAY  =  1.54  *  TDELAY 
TOTIM  =  TIME  +  TDELAY 
IF (NUMSP  .GE.  I ATPSD < 1 ) ) THEN 

CALL  SCHEDdl.IIPARM, TOTIM)  3  ATPAR2 


ELSE 

CALL  SCHEDdO.IIPARM, TOTIM)  3  ATPAR1 

END  IF 

C  GO  TO  SCHEDULE  UNTARV 
30  TO  200 

C*#**  INSUFFICIENT  AMMO  OR  EXACTLY  ENOUGH  AMMO  ON  3  1  P 


TIME  TO  SHIFT  PARTIAL  LOAD 


3-  25 


TPAR  =  IMIX(MIX»31>  *  (NRONSP  FRNN )  +  5.0 
NRNDSN  =  NRNDSN  -  NRONSP 
ITRUCK(NUMSP,6)  3  0 

I  TRUCK ( NUMTK » 6 )  =  ( NRONSP/FRNN)  *  10000 
C  SCHEDULE  RELEASE  OF  S  1  P  (SCHED  ATPAR1  OR  2> 

IF( IFLAG  .EQ.  1 ) THEN 

TDELAY  =  TDELAY  +  TPAR 
GO  TO  151 
ELSE 

TDELAY  =  TPAR 
END  IF 

151  I I FARM ( 1 )  3  NATP 
IIPARM<2>  3  NUMSP 
I IPARM( 4 )  3  555 

IF ( IDAY  .EQ .  0) TDELAY  3  1.54  *  TDELAY 

TQTIM  *  TINE  +  TDELAY 

IF ( NUMSP  .GE.  IATPSDU)  )THEN 

CALL  SCHED(11,II?ARM»TQTIM)  3  ATPAR2 

ELSE 

CALL  SCHED ( 10>IIPARM, TQTIM)  3  ATPAR1 

END  IF 

Cl***  IF  EXACTLY  ENOUGH  ROUNDS  ON  TRUCK , SEND  TRUCK  BACK  TO  UNIT 
IF(NRNDSN.EQ.O)  GO  TO  200 

C  GO  GET  ANOTHER  ASP-ATP  TRUCK  TO  COMPLETE  THE  LOAD 
IFLAG  3  1 
GO  TO  130 

C  HAVE  SUFFICIENT  AMMO,  SCHEDULE  UNTARV  AND  NEXT  ATP  DECREMENT 
200  IATP( NATP, IQTYPE+13)  3  IATP(NATP, IQTYPE+13)  -  1 

IF ( IATP(NATP, IQTYPE+13)  .L£.  0) IATP(NATP» IQTYPE+13) *0 
C  DECREMENT  AMMO  AND  AMMO  DEMAND 

IATP(NATP,NUMArt*3+13>  3  IATP(NATP,NUMArt*3+19) 

Z  -  IMIX ( MIX  » NUMAM ) 

IATP(NATP,NUMAM*3+1?)  3  IATP(NATP,NUMAM*3+ 1?)  - 
Z  IMIX ( MIX » NUMAM) 

IF ( NUMAM  .GT.  2  .AND.  NUMAM  .LE.  5) THEN 

IATP(NATPf 27)  3  IATP(NATPr 27)  -  IMIX (MIX, NUMAM) 

IATP(NATP»28)  =  I ATP (NATP, 23)  -  IMIX(MIX, NUMAM) 

IATP(NATP,51)  3  IATP(NATP,51)  -  IMIX ( MIX  » NUMAM) 

ELSE 

I F < NUMAM  .GT.  5  .AND.  NUMAM  .LE.  S ) THEN 

!ATP(NATP,42>  =  IAT?<NATP,42>  -  IMIX ( MIX . NUMAM) 

I A  TP (NATP, 43)  =  IATP(NATP,43)  -  IMIX(MIX, NUMAM) 

I  ATP ( NATP ,515  3  I  ATP ( NATP , 5 1 )  -  IMIX ( MIX , NUMAM ! 

END  IF 
END  IF 

CX**#  CHARGE  AMMO  ISSUED 

MIXIND  *  MIX  3  10TON  LOAD 

IF  ( I  TRUCK  ( NUMTK ,  1 )  ,NE.  1 )  MIXIND  =  MIX  -  20  3  5T0N  OR  10T0N  Mi.RS 
IF ( ITRUCK(NUMTK»5>  .EQ. ■ 105MIXIND  =  MIX  3  MLRS  10T0N  U/12  TLR 
IATPAM( NATP. MIXIND )=IATPAM( NATP, MIXIND )+l 
IF'.  IFLAG  .EQ.  1 ) THEN 
TLOAD  3  TDELAY 
ELSE 

TLOAD3 IMIX  v  MIX , 31 ) 


O  C*J 


IF  i IDAY. EQ .0 )  TLOAD  =  1.544TLQAD 
Ztttt  CHECK  IF  MLRS  AND  SCHEDULE  DEPARTURE 
IF  (NUMAM  .EQ.  10)  THEN 
DTIHE  *  TIME  t  TLOAD 
I IPARM! 1 )  =  NATF' 

IIF'ARM  (  2 )  =  -1 
I IPARM  <  4  >  =  0 

CALL  SCHEDOt  IIPARM»DTIME)  3  UNTARV 

CONTINUE 
END  IF 

C  SET  THE  VALUE  FOR  ARTY  OR  MANUVER  QUEUE 
KVAL  =  4 

IF ! IQTYPE  .EQ.  2)  KvAL  =  1 
C  ADD  ONE  TO  THE  NUMBER  SERVED  BY  THIS  QUEUE 
JATP(NATPfKVAL)  =  JATP(NA7P»KVAL)  +  1 
IF'.NUMAM  .EQ.  10)00  TO  153 
C****  SCHEDULE  THE  AVAILABILITY  OF  THE  SERVER 
I  TRUCK ( NUMSVR 1 3 )  =  4 
CALL  OPERA (NUMSVR- TLOADt TFAIL) 

DTIME  =  TIME  +  TLOAD  +  TFAIL 
IPARM ( 1 )  =  NATP 
IPARMC2)  =  NUMSVR 

CALL  SCHED(3» IPARM* DTIME)  3  UNTARV 

I  TRUCK ! NUMSVR » 6 )  =  ITRUCK(NUMSVRfS)  f  TLOAD 
IF(ITRUCK(NUMTKf 1)  .E3.1)  THEN 

ITRUCK( NUMSVR » 12)  =  ITRUCK!NUMSVR,12>  +  1  8  10  TON  CNTR 
ELSE 

ITRUCK(NUMSVR»11)  *  ITRUCK(NUMSVRfH)  +  1  3  5  TON  CNTR 
END  IF 

SCHEDULE  UNTARV  OF  SUPPLY  TRUCK 
153  ITRUCN ( NUMTK » 3 )  =  4 

CALL  INTRDK(NUMTK.TMIND) 

NUNIT  =  ITRUCK(NUMTK»4) 

IPARM(l)  *  NUNIT 
IPARM(2)  =  NUMTK 
MTYF'  =  IUNIT(NUNIT»1) 

C  *****  IF  SUPPLY  TRUCK  INTERDICTED^  SCHEDULE  ASF'ARV 
IFITMIND  .GT.  0 )THEN 
ITRUCM  NUMTK  »6>  =  0 
IPARM(3)  =  IUNIT (NUNIT  »3> 

IPARM ( 4 )  =  ITRUCK ( NUMTK » 5 ) 

TOTTIM  =  TIME  +  TMIND  +  TLOAD 

CALL  SCHED(5»IPARMf TOTTIM)  3  ASF'ARV 

JUNIT ( NTYP « 1 4 )  =  JUNIT( NTYP » 1 4  >  +  1 
RETURN 
END  IF 

DIST  =  IUNIT ( NUNIT  »4 ) 

ITKTYP  =  ITRUCK(NUMTKrl) 

TVLTIM  =  60.  *  DIST  /  TTYPE! ITKTYP » IOAY+1 ) 

CALL  OPERA! NUMTK fTVLTIMf TFAIL) 

JUNIT(NTYPfIS)  *  JUNIT ( NTYP  1 13)  +  1 
C  ADD  TO  THE  NUMBER  KILLED  AND  FAILED  THIS  TRIP 

IF! TFAIL  .GT.  0)  JUNIT(NTYP» 15)  =  JUNIT ( NTYP » 15 )  +  1 


SUBROUTINE  A TP Aft V 
SUBROUTINE  ATPARV  (IPAKM) 

C'****  EVENT  ATPARV  —  ARRIVAL  OF  UNIT  TRUCK  AT  ATP 
C  FIND  FORKLIFT  OR  CRAIN.  AND  A  3 X P  vSCHED  A 

C  EVENT  TYPE  4 
C  CALLED  BY  MAINARM 

C  CALLS  3CHED.  IQ.  FINTK,  PUTQUE ?  GFTQUE.  OPERA.  INTRDK 
C 

C**»*  J.  FOX  JAN  79 
C 

C#m  IPARM(l)  —  UNIT  NUMBER 
Cm*  IPARM< 2)  —  TRUCK  NUMBER 
C*m  IPARM<3)  —  ATP  NUMBER 

Cm*  IPARM ( 4 )  —  MIX  OR  999  =  RETURN  OF  PARTIALLY  LOADED  UNIT  7 
C 

Cm*  SCHEDULES  --  ASPARV.  ARRIVAL  OF  UNIT  TRUCK  AT  ASP 
C  (IF  AMMO  IS  NOT  CURRENTLY  ON  HAND  FOR  ALL 

C  TRUCKS  IN  QUEUE) 

C  —  ATP. SERVICE  OF  UNIT  TRUCK  FROM  QUEUE  AT  AT? 

C  —  ATPARV >  RESCHEDULE  30  MIN  LATER 

C****  SCHEDULED  BY  ATP.  ATPARV.  UNTDEP 

C  (IF  ATP  SERVICE  WAS  IDLE  FOR  THIS  QUEUE) 

C 

C*m  DATA  REQUIRED  —  AMMO  REQUIRED  BY  TRUCKS  IN  QUEUE. 

C 

INCLUDE  LOG. LIST 
DIMENSION  IPARM(5) 

C  LOCAL  VARIABLES  DEFINED 

C  NUMQ  -  ATP  QUEUE  FOR  ARTY  OR  ROUTINE  SERVICE 

C  NUMQS  -  SERVER  QUEUE 

C  MIX  -  INDEX  OF  AMMO  MIX  USED  T0ACCE3S  IMIX. 

C  NEEDTK  -  NUMBER  OF  ROUNDS  NEEDED  TYPE  I  BY  UNIT  TRUCK. 

C  INDEX  -  INDEX  COMPUTED  FOR  AMMO  TYPE  I  TO  ACCESS 
C  ONHAND  AND  WANTED  BY  TRUCK  IN  QUEUE. 

C  JONHAND  -  AMOUNT  OF  AMMO  TYPE  I  PRESENTLY  ON  HAND  AT  ATP 
C  NUMOLD  -  CHECK  TRK  FOR  SERVER 

C  NEEDOT  -  AMOUNT  OF  AMMO  I  NEEDED  BY  OTHER  TRUCKS  IN  QUEUE. 

C  MAMART  -  FLAG  SET  TO  2  IF  MANEUVER  AMMO.  1  IF  ARTY  AMMO 

C  DIST  -  DIST  FROM  ASP  TO  ATP. 

C  TVLTIM  -  UNOPPOSED  TRAVEL  TIME. 

C  TFAIL  -  TRAVEL  TIME  INCREMENT  DUE  TO  MECHANICAL  FAILURE 

0  TMIND  -  TRAVEL  TIME  INCREMENT  DUE  TO  INTERDICTION 

C  NFAOMD  -  TOTAL  RDS  NEEDED  BY  ALL  ARTY  TRKS 
C  TQTIM  -  TIME  OF  TRUCK  ARRIVAL  AT  ASP 
C 

NFL AG  =  0  8  SIP  FLAG 

NUNIT  =  I  FARM ( 1 ) 

NUMTK  =  IPARM(2 ) 

NATP  a  IPARM(3> 

IPART  a  IPARM ( 4 ) 


C 

C  DETERMINE  AMMO  MIX  WANTED  BY  THE  TRUCK. 

MIX  a  ITRUCK<NUMTK»5) 

C  ***  IF  ATP  ASSIGNMENT  HAS  CHANGED  WHILE  UNIT  TRUCK  IS  ENRGUTE . 


LATP  =  IUNIT(NUNITf2) 

IF ( NATP  .NE.  LATP ) THEN 
IPARM<3>  =  LATP 

ChlL  SCHED(4*IPARMfTIME  +  30.)  3 

RETURN 
END  IF 

IF(MIX.LE.O)  THEN 
URITE(6f 10)  NUMTK 

10  FORMAT ( '  ATPARV  —  ZERO  MIX  QN  TRUCK  ' » 1 4 > 

RETURN 
END  IF 

C  SET  ITRUCK(N»3>  EQUAL  TO  THE  TIME  OF  QUEUE  ENTRY •  THIS 

C  ALLOW  QUEUE  WAIT  TIME  TO  BE  FOUND  FOR  THE  TRUCK 

ITRUCK (NUMTKf  3>  =  TIME 
C  FIND  THE  UNIT  TYPE 

JTYP  =  I UN  IT (NUN  IT  >  1  > 

IF<IUNIT(NUNITf2) .EQ.OJGO  TO  400 
NUMAM  =  MIX 

IF (MIX  .GT.  L?PAR<7) ) NUMAM  =  MIX  -  LFPARC7) 

C  DETERMINE  QUANTITY  NEEDED  ON  THIS  TRUCK  (NEEDTK ) 

NEEDTK  =  IMIX (MIX f NUMAM )-(ITRUCK (NUMTK f6>*IMIX< MIX f NUMAM >+ 

Z  9999/10000) 

C  ASSUME  MANEUVER  AMMO. 

MANART  =  2 

C  IF  ARTY  RESET  MANART 

IF (NUMAM  .GT.  LPPAR<3)  .AND.  NUMAM  ,NE.  9) MANART  =  1 
IF ( IPART  .EQ.  999)GQ  TO  25 

C  HOW  MANY  ROUNDS  ARE  NFEDED  BY  THE  OTHER  TRUCKS  IN  THE  QUEUE 
INDEX  =  NUMAM  *3+19 
NEEDOT  a  IAT?(NATP, INDEX) 

C  HOW  MANY  ROUNDS  I  ARE  AT  ATP  -  JONHND 
JONHND  =  IATP ( NATP » INDEX  -  1) 

C  IF  INSUFFICIENT  ON  HAND  GO  TQ  400 

IF ( JONHND  .LT,  NEEDOT  +  NEEDTK >30  TO  400 
•:****  CHECK  IF  A  3  1  P  IS  AVAILABLE  FOR  RELOADING 
25  NATPQ  a  IQ(IATPSD(2)»NATP) 

30  CALL  FINTN ( NATPQ* NUMAM fNUMSP » 0 ) 

IF ( NUMSP  .NE.  0 ) GO  TO  40 
IF< NATPQ  .NE.  IQ ( I ATPSD < 3 > f NATP > ) THEN 
NATPQ  a  I Q < IATPSD<3) fNA  TP) 

30  TO  30 
ELSE 

IF ( IPART  .EQ.  999 > GO  TO  200 
IF ( NUMAM  .GE.  4  .AND.  NUMAM  . LE.7/THEN 
GO  TO  50 
ELSE 

GO  TO  SO 
END  IF 
END  IF 

HAVE  FOUND  A  TRUCK f  PUT  BACK  IN  QUEUE 
40  CALL  PUTQUE(NUMSPfNATPQ) 

NFLAG  »  1 

IF( IPART  .EQ.  999 ) GO  TO  30 
IF  NOT  ARTY  GO  TO  SO 


IF ( MAN ART  ,EQ.  1  .AND.  NUMAM  .£3.  10) 


TO  60 


;  HAVE  ARTY  IS  THERE  SUFFICIENT  POWDER 

;  HOW  MANY  ROS  ARE  NEEDED  BY  ALL  ARTY  TRKS  IN  3UEUE( SUFF ICIEf 
50  IF  ( NUMAM  .LE.  5)  THEN 

NFADMD  =  I  ATP ( NATP  >  31 )  +  I ATP ( NATP »  34 ) 

IF< I  ATP ( NATP » 27 )  -  IATP(NATP,28>  »6E .  NFADMD  +  NEEDTK}  I 
SO  TO  60 
ELSE 

GO  TO  400 
END  IF 
ELSE 

NFADMD  =  I  ATP ( NATP » 3  7 )  +  IATP(NATP> 40) 

IF ( IATP < NATP > 42 )  -  IATP ( NATP > 43 )  .GE.  NFADMD  +  NEEDTK)  i 
GO  TO  60 
ELSE 

GO  TO  400 
END  IF 
END  IF 
60  CONTINUE 

:  add  to  queue  demand  for  ammo  type 

I F ( IPART  .EQ.  999)G0  TO  80 
INDEX  =  NUMAM  *2+19 

IATP(NATP»INDEX)  =  IATP(NATP* INDEX)  +  IMIX'.MIX, NUMAM) 
C##**  IF  ARTY  ADD  TO  POWDER  »  IF  NOT  GO  TO  70 

IF ( MANART  .EQ.  1  .AND.  NUMAM  ,GT.  9)  GO  TO  70 
IF (MANART .EQ.2)  GO  TO  70 

IF (NUMAM  .GT.  LPPAR(3)  .AND.  NUMAM  .LE.  5) THEN 
IATP(NATF' » 28)  *1  ATP  (NATP » 28) +IMIX(  MIX » NUMAM) 

ELSE  IF (NUMAM  .GT.  5  .AND.  NUMAM  .LT.  9) THEN 
IATP<NATP»42)*IATP(NATP»  43 )+IMIX( MIX » NUMAM) 

END  IF 
70  CONTINUE 

C  INCREMENT  NUMBER  OF  TRUCKS  IN  THE  QUEUE 

IATP(NATP. MANART  +13)  =  IATP < NATP r MANART+13)  +  1 
IF ( NFL AG  .EQ.  0)G0  TO  200  3  NO  SJP 

C ***#  IF  MLRS  TRUCK  SCHED  ATP  EVENT  NOW 
C  IF  THERE  ARE  LESS  THAN  3  TRUCKS  ALREADY  LOADING 
80  IF  (NUMAM  .EQ .  10;  THEN 

IF ( IATP< NATP » 3 !  .LT.  3)  THEN 
IATP(NATPf 3)  =  IATP(NATP»3)  +  i 
IPARM(l)  =  1 
IPARM(2>  =  NATP 
IP ARM ( 3 )  =  NUMTK 
IPARM( 4)  =  NUMTK 
CALL  SCHED(6»IPARM.TIME> 

RETURN 

ELSE 

ITRUCK(NUMTK»15)  =  ITRUCX( NUMTK *  15 )  +  1  3  MLRS  WAITS 
GO  TO  200 
END  IF 
END  IF 

C**M  FIND  THE  QUEUE  FOR  SERVERS 
NUMQS  =  IATP ( NATP » 10 ) 

C  GET  A  SERVER  FROM  THIS  QUEUE 


1  •?  MLRS  WAITS 


NUHOLD  =  NUHSRV 

C  IF  NO  SERVER  PUT  THE  TRUCK  IN  ITS  PROPER  QUEUE 
IF ( NUHSRV  .EQ.  0 ) THEN 

IATP(NATP*20)  =  I ATP ( NATP * 20 )  +  1  3  'NO  SERVER'  CNT 
GO  TO  200 
END  IF 

C  HAVE  A  SERVER  PROCESS  THE  HANUVES  OR  ARTY  QUEUE  AS  DIR 
IF< HANART  .EQ.  2)  THEN 
100  IF< I TRUCK ( NUHSRV* 1 )  , NE.  9)  GO  TO  110 

C*m  HAVE  A  FORKLIFT  FUR  HANUVER  TRUCK *  SCHEDULE  ATP  EVEN 
IPARHU)  =  2 
IPARHU)  =  NATP 
IPARH(3>  =  NUHTK 
IPARHU)  =  NUHSRV  - 
CALL  3CHED( S* IPARH » TIHE ) 

RETURN 

C 

Cm*  NOT  A  FORKLIFT*  TRY  AND  FIND  ONE 
110  CALL  PUTQUE( NUHSRV  *NUHQS ) 

C  GET  A  NED  SERVER- 

CALL  GETQUE ( NUHSRV  *  NUNQS  > 

IF < NUHSRV  .NE.  NUHOLD >  GO  TO  100 
ELSE 

C****  PROCESSING  AN  ARTY  TRUCK 

120  IF< I TRUCK (NUHSRV* 1 )  .NE.  9)  GO  TO  130 
cm*  HAVE  A  CRANE  WITH  THE  ARTY  TRUCK  SCHEDULE  ATP  EVENT 
IPARHU)  =  1 
IPARH(2)  =  NATP 
IPARH<3)  =  NUHTK 
IPARHU)  =  NUHSRV 
CALL  SCHED( 6* IPARH*TIHE ) 

RETURN 

C  NOT  A  CRANE*  TRY  AND  FIND  ONE 

130  CALL  PUTQUE< NUHSRV *NUHQS) 

C  GET  A  NEW  SERVER 

CALL  GETQUE < NUHSRV *NUHQS) 

IF’’ NUHOLD  .NE.  NUHSRV)  GO  TO  120 
C  CANNOT  FIND  A  CRANE*  USE  THE  FORK-IFT 

IPARH(l)  -  1 
IPARHU)  «  NATP 
IPARH ( 3 )  =  NUHTK 
IPARHU)  =  NUHSRV 
CALL  SCHEDl 6*  IF'ARH* TIHF  * 

RETURN 

r 

END  IF 

C  FIND  QUEUE  NUHBER  -  NIJHQUE 
200  NUHQ  =  IATP(NATP* HANART  +10) 

CALL  PUTQUE( NUHTK* NUHQ) 

RETURN 

C  INSUFFICIENT  AHHO  SEND  TO  ASP 
C  FIND  HIST  TO  ASP 

400  DIST  =  IUNIT  C  NUN  IT  *5 )  “I  UNIT  ( NI.IN  IT  *  4 ) 

ITKTYP  =  I  TRUCK (NUHTK* 1 ) 


CHANGE  TRUCK  STATUS  CODE 
I  TRUCK ( NUMTK  » 3 )  =  5 
COMPUTE  INTERDICTION  DELAY  -  TMIND 
CALL  INTRDK ( NUMTN >  TMIND ) 

IF ( TMIND  .LE.  0.)  THEN 

COMPUTE  DELAY  DUE  TO  FAILURE  -  TFAIL 
CALL  OPERA ( NUMTK »  TVLTIM» TFAIL) 

ELSE 

TFAIL  =  0. 

END  IF 

COMPUTE  ASP  ARRIVAL  TIME  -  TGTIM 
TOTIM  =  TIME  +TVLTIM  +  TFAIL  +  TMIND 
:*:***  RECORD  NO.  OF  TRUCKS  BUMPED  TO  ASP 
INDEX  =  NUMAM  +  20  3  10T0N  BUMPED 

IF ( ITRUCK ( NUMTK» 1 )  ,NE.  1)  INDEX  =  NUMAM  +  30  3  5T  OR  10T  MLRS 
IF ( ITRUCK ( NUMTK  >  5 ) .EQ . 10 ) INDEX  =  NUHAM+20  3  MLRS  10T0N  W/  12  TLR 
I  ATP  AM  ( NATP  i  INDEX ;  =  IATFAM  ( NATP» INDEX )  r  1 
I  FARM ( 3 )  =  IUNIT < NUNIT  *3) 

TRUCK  IS  BEING  BUMPED  TO  ASPi  ADD  ONE  TO  THE  NUMBER  SENT 
JUNIKJTYP.9)  =  JUNIT  < JTYP  *9  >  +  1 

ADD  TO  THE  INTERDICTION  AND  FAILURE  COUNTERS  FOR  THIS  MOVE 

IF < TMIND  »GT.  0) JUNIT ( JTYF’r 10)  =  JUNIT ( JTYP f 10)  +  1 

IF ( TFAIL  .GT.  0)  JUNIT ( JTYPj 11 )  =  JUNIT(JTYP»11)  +  1 

ADD  THE  TRAVEL  TIME  TO  THE  CUMULATIVE  TRAVEL  TIME  FDR  THIS  MOVE 

JUNIT (JTYP » 12 )  =  JUNIT ( JTYP> 12 )  *  TVLTIM 

I  FARM ( 4 ) *ITRUCK< NUMTK  »5 ) 

CALL  SCHED(5»IPARM, TOTIM)  3  ASF'ARV 

ITRUCK ( NUMTK » 14 )  =  ITRUCK( NUMTK f 1 4 )  +  1  3  BUMP  TO  ASP  CNTR 


RETURN 


SUBROUTINE  ATPAR1 
SUBROUTINE  ATPAR1  ( IPARM ) 

CXXXX  EVENT  ATPAR1  —  ARRIVAL  OF  S  1  P  AT  AT?  FROM  CSA 
C  LOOKS  FOR  EMPTY  TRAIL  TQ  TAKE  BACK  TO  CSA 

C  EVENT  TYPE  10 

C  CALLED  BY  MAINARM 

C  CALLS  OPERA*  SCHEB*  IQ*  PUTQUE*  GETQUE >  INTRUK 
C 

CXXXX  J.  FOX  JAN  7? 

C 

CXXXX  I  FARM ( 1 )  —  ATP  NUMBER 
C**XX  IPARM(2)  —  SiP  NUMBER 

CXXXX  IPARM( 3)  —  ASSOCIATED  AS?  NUMBER  'MIX  IF  CSA  TQ  CFA-ATP  LINK) 
CxXXX  IPARM ( 4 )  —  555  :  RETURN  FROM  RELOAD  333:  ARRIVAL  AT  DAO 
C  MIX  IF  FROM  CSADE? 

C 

C  SCHEDULES  A3PAR2 »  BUMP  ->  ASP  IF  ATP  IS  OVERSTOCKED 
C  ATPAR1,  RESCHEDULE  IN  30  MIN  OR  DIVERT  TQ  2ND  ATP 

C  CSAAR'V,  EMPTY  TRUCK  TO  CSA 

C  SCHEDULED  BY  ATP*  ATPAR1 *  CSADE? 

CXXX*  PUTS  TRUCK  IN  CSA-ATP  QUEUE 


C 

CXXXX  CHANGES  —  ATP  AMMO  SUPPLY. 

C  NOTE:  EACH  tractor  HAS  TWO  TRAILERS!  FOR  ATP  S4PS  THE  TRACTOR 

C  .  IS  ASSOCIATED  WITH  A  FULL  TRAILER  (AT  THE  ASP  THE  TRACTOR 

C  GOES  WITH  THE  EMPTY  TRAILER). 

C 


INCLUDE  LOG.LIST 

DIMENSION  IPARM ( 5 )  » I IFARM C 5 ) 

INTEGER  AVAIL 

C 

CXXXX  LOCAL  VARIABLES 

CXXXX  MIX  —  MIX  OF  AMMO  INDEX  CARRIED  ON  THE  TRUCK  FROM  THE  CSA 
CXXXX  NATPQ  —  NUMBER  OF  QUEUE  FOR  L-iA  -  ATP  TRUCKS 
CXXXX  IND  —  INDEX  FOR  CURRENT  AMMO  SUPPLY  BASE  ON  IATP  DEFINITION 
CXXXX  LATP  —  ATP  WITH  LOWEST  STOCK 

CXXXX  LEAST  —  STOCK  AT  LATP 
« 

L 

NATP  =  IPARM ( 1 ) 

NUMSP  =  IPARM<2) 

HASP  =  I ATP (NATP. 6)  -  10 
ISTAT  =  IPARM ( 4 ) 

r 

IF ( NUMSP  .EQ.  0 )G0  TO  10 
IF ( ISTAT  .EQ.  555>G0  TO  3 
CXXXX  FIND  THE  MIX  ON  THE  TRUCK 
MIX  =  ITRUCK ( NUMSP  *  5) 

C  DETERMINE  AMMO  TYPE 

CXXX  NUMAM  IS  FOR  IATP  ARRAY  ==  IAM  IS  FOR  IMIX  ARRAY 
C  X  X  X  X  X  THE  ABOVE  DIFFER  ONLY  FOR  FUZFS  (MIX  30; 

NUMAM  *  MIX  -  LPPAR ( 3 ) 

IAM  =  NUMAM 

IF ( MIX  .EQ.  30 ) NUMAM  =  11 
IF(MIX.LE.  0)  THEN 


3-  34 


O  o 


2  FORMAT v '  ATPAR1  —  ZERO  MIX  ON  TRUCK  ',14) 

RETURN 
END  IF 
C 

LATP  =  NATP 

C  I ATPSD ( 4 )  =  CFA  ATP  t 

IFdSTAT  ,NE.  333  .OR.  NATP  .EQ.  IATPS0(4))GQ  TO  3 
C ****  DETERMINE  ATP  DESTINATION  (FROM  DAO) 

70  IND  =  NUMAM  *  3  +  18 
C*  *  *  AVAILABLE  =  ONHAND  -  DEMAND  +  QN-THE-UAY 

AVAIL  =  I ATP ( NATP, IND )  -  I ATP ( NATP , IND+1 )  +  I  ATP ( NATP , IND+2 ) 
LEAST  =  AVAIL 

IF  (NUMAM  .EQ.  9)  GO  TO  95 

C  #**  IF  AMMO  AT  PARENT  IS  LOU,  SCHEDULE  ARRIVAL  TO  IT 
IAMCK  =  lAMLVLd, NUMAM)  *  .75 
IF ( AVAIL  .LT.  IAMCK ) GO  TO  90 
C  *:*:*  FIND  ATP  WITH  LEAST  AMMO  ON  HAND 
IF ( NATP  .LE.  3 5  THEN 
JLGW  =  1 
JHIGH  =  3 
ELSE 

JLGW  =  4 
JHIGH  =  5 
END  IF 

DO  90  J  =  JLQW, JHIGH 

AMAV  =  IATP<  J»  IND)  -  IATP(J,  IND+1 )  +  IATP  ( J ,  INO+2 ) 

IF( AMAV  . GE.  LEAST) GO  TO  80 
LEAST  *  AMAV 
LATP  =  J 
90  CONTINUE 

IF (  , 7  *  AVAIL  .LT.  LEAST)LAT?  =  NATP 


*  IF  .GT.,  ATPS  OVERSTOCKED,  SEND  SSP  TO  ASSC  ASP 
IF( LEAST  *  100  ,GT .  IAMLVL(lr2?)  *  IAMLVL( 1 , NUMAM) )THEN 
IF ( I ASP ( NASP , 2 )  .LT,  1)  NASP  =  I  ASP (N ASP, 11 )  -  10 

DIST  =  ABS< IATP(NATP«3)  -  I  ASP ( NASP , 1 ) ) 

ITYP  =  I  TRUCK ( NUMSP ,  1 ) 

TRTM  =  60.  *  DIST  /  ITYPE( ITYP, IDAY+3) 

CALL  OPERA ( NUMSP , TRTM » TF A IL ) 

I IP ARM ( 1 )  =  NASP  +  10 
I IP ARM ( 2 )  =  NUMSP 
I IPARM<  3 )  =  0 
I  I.-ARM(  4  )  =  44  4 

CALL  5CH ED (13, IP ARM, TIME  +  TRTM  +  TFAIL ) 

WRITE (6, 24 5 NUMSP, MIX, NASP +10, TIME 

FORMAT ( '  ATP  SJP',13,'  MIX', 13,'  DIVERTED  TO  ASP', 13, 
•  '  AT  TIME' ,F3.1 ) 

I  ASP ( NASP , IND  +  2 )  =IASP(NASP, IND  +  2)  +  IMIX(MIX, IAM) 
RETURN 
END  IF 


9  ASPAR 


IF(NATP  .NE.  LATP ) WRITE ( 6 , 26) NATP , NUMSP » MIX » LATP »  TIME 
26  FORMAT''  ATP', 13,'  S8P',I5,'  MIX', 13,'  DIVERTED  TO  ATP'. 13, 
Z  'AT  TIME' ,F9. 1 ) 


cm* 


c 

C**** 


C 

C**** 


Cl*** 

cm* 

10 


c 

c**** 

C*#** 


15 

C 

C  **** 


IPARM(l)  =  LATP 
)  IP  ARM  ( 4  )  =  0 

D I  ST  =  IATP(LATP»  1 )  -  IATP(LATP»3) 

ITYP  =  ITRUCK • NUrtSP » 1 > 

TRTM  =  60.  *  0 1  ST  /  I  TYPE ( ITYP* IDAY  +  3J 
CALL  OPERA (NUMSP.  TRTM.TFAIL ) 

TQTTIn  =  TIME  +  TRTM  +  TFAIL 

CALL  SCHED(10»IPARM»TQTTIM)  '  !}  ATPAR1 

IATP(LATP»NUMAM*3+20)  =  IATP(LATP»NIIMAM*3+20)  +  IMIX ( MIX . I  AM ) 
RETURN 

t  PUT  TRUCK  IN  CSA-ATP  AMMO  QUEUE 

5  IF  (TIME  .GT.  1440.  .AND.  NATP  .EG.  IATPSIK 4)  )  THEN 
MATP  =  1 
LATP  =  1 
GO  TO  70 
END  IF 

MATPQ  =  I Q ( 2 >  NATP) 

MTSP  =  NUMSF' 

IF( ITRUCK( NUMSP »6)  .LE.  0  .AND.  IATP'NATP.5)  .GT.  0) 

ZGO  TO  30 

CALL  P'JTQUE(  NUMSP.  NATF'Q) 

IFCSTAT  .EG.  555) THEN 
ITRUCK(NUMSP>3)  =  TIME 

IF ( ITRUCK ( NUMSP * 6 )  .GT.  0 ) ITRUCK ( NUMSP » 3 >  =  2 
RETURN 
END  IF 

l  ADD  AMMO  TO  THAT  AVAILABLE  -  DECR  ON-THF-WAY 
IND  =  NUMAM*  3+18 

lATP(NATP.IND)  =  IATP(NATP, IND)  +  C IMIXCMIXr IAM) 

Z  *  ITRUCK ( NUMSP  *  6 )  +  ???9)/10000 
I ATP ( NATP » IND+2 )  =  IATP( NATP » IND+2 )  -  ( IMIX ( MIX » IAM) 

Z  *  ITRUCK ( NUMSP > 6 )  +  9?99>/10000 
IF( MIX .  EG.  SO) GO  TO  7 

IATPSF'(NATP.  NUMAM)  =  I ATPSP  ( NATP  >  NUMAM)  +  1 

t  UPDATE  TRUCK  STATUS  TO  THE  CSA-ATP  QUEUE 
IF ( ITRUCK ( NUMSP *3) .GE. 4 ) IATP (NATP j  5)  =  I ATP ( NATP.5) +1 
ITRUCK (NUMSP?  3)  =  2 

ITRUCK  ( NUMSP  *  10 )  =  ITRUCK(NUMSF'dO)  +  13#  ARRIVALS  FROM  CSA 
i  CHECK  QUE  FOR  EMPTY  S  1  PS 
(  BRING  FIRST  3  i  P  FROM  QUEUE (MTSF) 

IF ( I A TP (NATP>5)  .LE.  0)G0  TO  50 
NATPG  =  IQ( 2»NATP) 

CALL  GETQUE< MTSP .NATPG) 

li  SEARCH  FOR  EMPTY  S  1  f-  STORE  NCHTK  AND  PUT  IT  BACK 

t  IN  QUEUE. 

NCHTK  =  MTSP 

IF ( NCHTK  .EQ.  0)G0  TO  50 

CALL  PUTGUEvMTSP. NATPG) 

5  CALL  3ETQIJE (MTSP* NATPG) 

«  DETERMINE  TRUCK  LOAD 


WRONG  TRUCK >  PUT  BACK  IN  QUEUE 
CALL  PUTQUECMTSP.NATPQ) 

IF  LAST  TRUCK. GO  TO  50 
IF ( MT3P  .EQ.  NCHTK ) GO  TO  50 
GO  TO  15 

*:**  FOUND  EMPTY  TRUCK  -  SCHED  CSA  ARRIVAL 

DETERMINE  DISTANCE  TO  RE  TRAVELED 
30  DIST  =  IATP (NATP » 1 ) 

ITKTYP  =  ITRUCK ( MTSP . 1 ) 

TRTM  =  60.  *  D I ST/I TYPE ( ITKTYP  > IDAY+2 ) 

IF( ITRUCK ( MTSP r 3)  .GT.  10) THEN 
NT  IQ  =  TIME  -  ITRUCK(MTSP.3) 
ITRUCK(MTS?»13>  =  ITRUCK (MTSP .13)  +  NTIQ 
END  IF 

ITRUCK(MTSP.3)  =  4 

INTERDICTION  DELAY  -  TMIND 
CALL  INTRDMMTSP. TMIND; 

IF  (TMIND  .LE.  0.)  THEN 

COMPUTE  DELAY  DUE  TO  FAILURE  -  TFAIL 
CALL  OPERA (MTSP. TRTM .TFAIL) 

ELSE 

TFAIL  =  0. 

END  IF 

TOTTIM  =  TRTM  +  TIME  +  TFAIL  +  TMIND  +  20. 
IIPARM(l)  =  NATP 
IIPARMC2)  =  MTSP 
IIPARM<3>  *  IATP(NATP.6) 

IIPARM<4)  *  0 

ASSUME  CSA  -  ATP  TRUCK 
CALL  SCHED(9.IIPARM, TOTTIM) 

IATF<NATP»5)  =  IATP(NATP.S)  -  1 
RETURN 

NO  EMPTY  TRUCK  FOUND  SCHED  FALSE  EVENT 
50  IPARM<2>  *  0 

CALL  SCHED ( 10 » IP ARM .TIME  +  30.) 


3  CSAARV 


3  ATPAR1 


RETURN 


c***x 

c 

c 

c 

c 

r 

w 

C 

CXX** 

C 

c**** 

C'JiXXX 

C***X 

CXXXX 

C 

C 

C 

c 

c 

c*#** 

c 

C  :*:«#* 


SUBROUTINE  ATPAR2 
SUBROUTINE  ATPAR2  (IPARM) 

EVENT  ATPAR2  --  ARRIVAL  GF  S3P  AT  AT?  FROM  ASP  (OR 
RELOADING  IN  ATP). 

FULL ,  PUT  IN  QUEUE:  EMPTY ,  SEND  TO 

EVENT  TYPE  11 
CALLED  BY  MAINARM 

CALLS  IQs  PUTQUE ,  OPERA,  INTRDK ,  SCHED 

J.  FOX  JAN  79 

IF'ARM(l)  —  ATP  NUMBER 

IPARM<2;  --  TRUCK  NUMBER 

IPARM(3)  —  ASSOCIATED  ASP  NUMBER 

IPARM ( 4 )  —  555  1  MEANS  RETURN  FROM  RELOAD 

OR  MIX  :  (FROM  ASPAR1 )  SERVICE  OF  ATP  TO  ASP 


SCHEDULES  ASPAR1,  EMPTY  SSP  ->  ASF- 
SCHEDULED  BY  ASPARli  ASPAR2,  ATP 

PUTS  TRUCK  IN  ASP-ATP  QUEUE 


CHANGES 


—  ATP  AMMO  SUPPLY. 


C 

C*:t** 
C***X 
C  **** 
C**** 
C#*** 
C***X 


INCLUDE  LOG, LIST 
DIMENSION  IPARM(5),IIPARM(5) 

LOCAL  VARIABLES 

MIX  —  MIX  NUMBER  OF  AMMO  CARRIED  ON  THE  TRUCK 
NATPQ  —  NUMBER  OF  ATP  QUEUE  FOR  LOADED  AMMO  TRUCKS 
IND  —  INDEX  FOR  CURRENT  AMMO  SUPPLY  IN  IATP. 
ISTAT  —  IPARMv 4)  MIX  OR  555<RTN  RELOAD) 

MTSP  —  TRUCK  NUMBER  OF  AN  EMPTY  SSP  ->  ASPARi 


NATP  =  IPARM(l) 

NUMSP  =  IPARM ( 2  ) 

ISTAT  =  IPARM <  4 ) 

C 

IF ( ISTAT  .EQ.  555 ) GO  TO  3 
ClUtt  FIND  MIX  NUMBER  ON  TRUCK 
MIX  =  ITRUCK ( NUMSP ,  5) 

IF C MIX  .LE.  05  THEN 
ilRI TE<  6, '’)  NUMSP 

2  FORMAT ( '  hTPAR2  —  ZERO  MIX  ON  TRUCK  ',14) 
RETURN 
END  IF 


■:*«.**  PUT  TRUCK  IN  ATP  AMMO  TRUCK  QUEUE 
3  IF ( ITRUCK'NUMSP.o)  .LE.  0 ! THEN 
MTSP  *  N  U  M  3  P 
3G  TO  30 
END  IF 

NATPQ  s  IQ( 3 « NAT? ) 

CALL  PUTQUE  (NUMSP,  NATPQ: 


O  O 


:«***  ADD  AMriO  TO  AMMO  AVIALABLE  -  DECR  ON-THE-WA Y 
*  *  *  NUMAM  IS  FOR  IATP  ARRAY  ==  IAM  IS  FOR  IrtI X  ARRAY 
0  *  *  *  *  *  THE  ABOVE  DIFFER  ONLY  FOR  FUZES  (MIX  30) 

NUMAM  =  MIX  -  LF'F'AR  < 3 ) 

I  AM  =  NUMAM 

I F •: H I X  .Eli.  30 ) NUMAM  =  11 

1ND  =  NUMAM  *3+13  3  ON  HAND 

IAT?( NATP  ,  IND )  =  IATP < NATP, IND)  +  ( IMIX(MIX> IAM)  *  ITRUCK 
Z  (NUMSP»6)  +  999?)  /  10000 

IATP ( NATP » IND+2 )  =  IATP ( NATP • IND+2 )  -  ( IMIX( MIX , IAM)  *  ITRUCK 
Z  (NUMSP,6)  +  9999)  /  10000  0  ON-THE-WAY 

IATF'SP(  NATP  f  NUMAii+1 1 )  =  IaTPSP(NATP»NUMAM+11  )  +  1 
C 

C**»*  UPDATE  TRUCK  STATUS  TO  BEING  IN  THE  ATP  QUEUE 
C  IF ( ITRUCK ( NUMSP » 3 ) .EQ.4) IATP (NATP ,5)=IATP(NATP,5)+1 

ITRUCX(NUM3P>  3)  =  2 

ITRUCK (NUMSP » 10)  =  ITRUCK(NUMSP, 10)  +10*  ARRIVALS  FROM  ASP 
C 

RETURN 


C*:***  HAVE  FOUND  EMPTY  TRUCK  -  SCHED  ASP  ARRIVAL 
C  DETERMINE  DIST  TO  BE  TRAVELED 

30  DIST  =  IATP ( NATP » 2 ) 

ITKTYP  =  ITRUCMMTSP, 1 ) 

TRTM  =  60.  *  DIST  /  ITYPE( ITKTYP, IDAY+3) 

ITRUCK ( MTSP * 3 )  *  4 

C  COMPUTE  INTERDICTION  DELAY  -  TMIND 

CALL  INTRDK(MTSP, TMIND) 

IF ( TMIND  .LE.  0.)  THEN 

C  COMPUTE  DELAY  DUE  TO  FAILURE  -  TFAIL 

CALL  OPERA ( MTSP ,  TRTM,  TFAIL) 

ELSE 

TFAIL  =  0. 

END  IF 

TOTTIM  =  TRTM  +  TIME  +  TFAIL  +  TMIND  +  20. 

I  IF'ARM  <  1 )  =  NATP 
IIPARM(2)  =  MTSP 
IIPARM(3)  =  I ATP (NATP, 6) 

C  ASSUME  ASP  -  ATP  TRUCK 

CALL  SCHEIK12,IIPARM, TOTTIM)  0  ASPAR1 

C 

RETURN 


SUBROUTINE  CONTRL 
SUBROUTINE  CONTRL  (TIME) 

C  EVENT  TYPE  IS 
C  CALLED  BY  MAINARM .  IN  IT  f  SCHED 

C  CALLS  EDI TD  >  REPORT.  SCHED.  CREEVT 

C 

0****  ALLOWS  INTERACTIVE  CONTROL  FOR  DATA  EDITING 
C*.***  ALLOWS  SCHEDULING  OF  NEXT  CONTRL  TIME . 
cm*  H.  JONES  FEB  7? 

C 

C  SCHEDULES  CONTRL.  ENDSIM 
C  SCHEDULED  BY  CONTRL 
DIMENSION  I FARM ( 5) 

10  WRITE (6.20)  TIME 

15  FORMAT ( '  (1)  -  EDIT  DATA  './, 

2  '  (2)  -  WRITE  REPORT  './. 

2  '  (3)  -  SCHEDULE  CONTROL  ' »/, 

2  '  (4)  -  RETURN 

2  '  (5)  -  STOP  SIMULATION  NOW  './. 

Z  '  (6)  -  EDIT  TRUCK  QUEUES 
2  '  (7)  -  CREATE  EVENTS') 

20  FORMAT ( '  TIME  =  '»F9.2»/»'  ?') 

READ(5,*.ERR=25)  IQPT 

IF ( IOPT  .LT.  1  .OR.  IOPT  .GT.  7)  GO  TO  25 
GO  TO  (30.  40.  50.  70.  60.  65.  63).  IOPT 
25  URITE(6»15) 

GO  TO  10 
C****  EDIT  DATA 
30  CALL  EDITD 
GO  TO  10 

cm*  WRITE  REPORT 
40  CALL  REPORT  (9) 

GO  TO  10 
C 

cm*  SCHEDULE  CONTROL 
50  WRITE(6»55) 

55  FORMAT ('  ENTER  TIME  FOR  NEXT  CONTROL  ' ) 
READ(5.*)  TNEXT 

CALL  SCHED  (19.  IPARM.  TNEXT)  3 

GO  TO  10 
C 

Cm*  EDIT  TRUCK  QUEUES 
65  CALL  TRKPUT 
GO  TO  10 
C 

C*m  CREATE  EVENTS 
68  CALL  CREEVT 
GO  TO  10 

C 

C*m  STOP  SIMULATION. 

60  IPARM (  1 )  =  3883 
IPARM<  2)  =  3338 
IPARM(3)  *  3333 


AND  REPGR 


CONTRL 


SUBROUTINE  CREEVT 
SUBROUTINE  CREEVT 

C***»  ENABLES  INTERACTIVE  CREATION  OF  EVENTS  SUCH  AS  TRUCKS 
C***t  TO  ARRIVE  AT  AN  ATP  FROM  THE  C3A  IN  MID-CI. 

C 

C  CALLED  FROM  ARM  MENU(CONTRL) 

C  CALLS  REAOF  TO  GET  VALUES  FROM  THE  KEYBOARD 

C  SCHED  TO  SCHEDULE  THE  CREATED  EVENT 

C ****  JAMES  FOX  ESQ.  DDT.  TNT.  MARCH  NINETEEN  HUNDRED  AND  SEVENTY  NTN 
C 

C:m*  LOCAL  VARIABLE  DEFINITION 

C#*S*  IF'ARM  -  CONTAINS  THE  5  PARAMETERS  OF  THE  EVENT 

0 ****  INT3R  -  '  '  UP  TO  6  INTEGER  VALUES  FROM  THE  CONSOLE 

C***«  IUORD  -  '  '  UP  TO  6  ALPHA  VALUES  FROM  THE  CONSOLE 

C**l*  REAL  -  '  '  UP  TO  a  REAL  VALUES  FROM  THE  CONSOLE 

Ctttt  IEND  -  '  'END  OF  INPUT  CHECK 

C*x**  TOTIM  -  TIME  OF  SCHEDULED  EVENT 

C****  ITYP  -  EVENT  TYPE 

C*XX*  IPARM(i)  -  UNIT/ATP/ASP  NO. 

C****  IP ARM ( 2 )  -  TRUCK  NO. 

C 

CHARACTER* 10  IUORD. I HELP* IEND 

DIMENSION  IPARM<5)  .INTGRU)  .IUORDU)  .REAL (a) 

DATA  IHELP  /'HELP'/ 

DATA  IEND  /'END'/ 

C 

5  WRITEU.100) 

LU1  =  5 

10  URITE( 6, 150 ) 

150  FORMAT ( / . IX. '  ?  ') 

CALL  READF (LU1. 4. INT3R. REAL .IUORD) 

C****  IF  END  OF  INPUT  RETURN  (200) 

!F< IUORD( 1 ) . EQ.ISND)  GO  TO  200 
IF(IUORDU) .EQ. IHELP)  GO  TO  5 
C**«  LOAD. EVENT  TYPE.  PARAMETERS.  AND  TIME 
ITYP  =  INTGRU) 

IF ( ITYP.LE .O.OR . ITYP.GT .17)  GO  TO  10 
DO  20  I  *  1.5 

IPARM(I)  =  INTGRd  +  l) 

20  CONTINUE 

TOTIM  ’  REALU) 

CALL  SCHED ( ITYP. IPARM* TOTIM) 

GO  TO  10 
C 

100  FORMAT ( '  TO  CREATE  AN  EVENT.  INPUT  AS  A  GROUP  SEPARATED  BY'./. 

2  '  COMMAS  OR  SPACES  THE  FOLLOWING  7  VALUES  './. 

Z  '  EVENT  TYPE  (INTEGER  VALUES  BETWEEN  1  AND  17).'./. 

Z  '  5  PARAMETERS  FOR  EACH  EVENT' INTEGER. DEPEND  ON  EVENT  TYPE 
2  '  AND  TIME  (DECIMAL  MINUTES.  REAL).'./. 

Z  '  EXAMPLE:  10.1.512.0.0.0.305.'./. 

Z  '  CSA-TO-ATP  TRUCK  512  WILL  ARRIVE  AT  ATP  AT  TIME  =  305  MIN 


SUBROUTINE  CSAARV 


SUBROUTINE  CSAARV  { IPARM ) 

C**$*  EVENT  CSAARV  —  ARRIVAL  VF  SXP  TRUCK  AT  i'.Sh 
C  TRUCK  IS  SERVICED  FRO*  CSA  STOCK  i  Si- NT  Fa 2 

C  EVENT  TYPE  9 

C 

C:m*  LARRY  TOLIN  AUG  32 
C 

C ****  IPARM(l)  —  ATP  NUMBER  OR  ASP  NUMBER 

C%t**  IPARM<2>  —  TRUCK  NUMBER 

C**:**  IPARM<3>  --  ASSOCIATED  ASP  NUMBER 

C****  IPARM(4)  —  "l*  FLAG  FOR  INITIAL  REPLENISHMENT  TRIP 

C  ( OTHERWISE  30  MIN.  HITCH/UNHITCH  TIME) 

C  --  *-l *  FLAG  TO  PUT  SiP  INTO  CSA  QUEUE 

r 

C  CALLED  BY  MAINARM 

C  CALLS  PUTQUE*  SCHED*  GETQUE 

C 

C****  SCHEDULES  —  CSADEP  —  UNLESS  STOCKAGE  OB  JECTIVE  IS  MF7  AT  AS 
C  SCHEDULED  BY  ASPAR2*  ATPAR1 
C 

C:****  CHANGES  —  CSA  AMMO  SUPPLY. 

C  LOCAL  VARIABLES 

C  HITCH  t-  TIME  TO  HITCH  UP  THE  SSP 

C  INITL  —  IPARM<  4) t  INITIAL  REPLEN  TRIP  *  1=YES 

C  THESE  VARS  ARE  USED  TO  FIND  MIX  TO  GET: 

C  AMCODE  —  LOOP  TO  FIND  UORST  NEEDED  TYPE 

C  AMPCT  —  LEAST  Z  SO  FAR 

C  ASPPCT  —  Z  AT  NIJMASP 

C  NLASP  —  ASP  WITH  ASPPCT 

C  NUMASP  —  ASP  THAT  THE  SiP  WILL  GO  TO 

C  PCT  —  PERCENT  OF  AMCODE  AT  ASP 

C 

INCLUDE  LOG *LIST 
DIMENSION  IPARM< 5 ) 

INTEGER  AMCODE* ASP 
C 

INITL  *  IPARH<4> 

IF( INITL  .EQ.  1 ) THEN 
HITCH  =  0. 

ELSE 

HITCH  *  30. 

END  IF 
C 

NUMSP  *  IPARM  <  2 ) 

ITRUCK(NUMSP*3)  =  3 

C  *  I  *  *  TO  MAKE  THE  *TMO'  DECISION  PROCESS  INTERACTIVE  FOR 
C  SCHEDULING  CONVOYS  TO  EITHER  ASPS  AND/OR  ATPS*  CHANGE  THE 

C  SETTING  OF  ,IPARM(4)‘  TO  ‘-l*  IN  ASPAR2  ANU/OR  ATPAR5  * 

C  RESPECTIVELY 

C 

C  THEN  SCHEDULE  SIPS  (USING  SSG  ADDEVTSARM)  UITH  ’IPARMU)* 

C  EQUAL  TO  ’I1 


IF* INITL  .EQ.  -DTHEN 
CALL  PUTQUEt NUMSP.  176) 

RETURN 
END  IF 
r 

IF ( ITRUCK ( NUMSP . 4 )  , GT ,  35)G0  TO  10 
C 

C  *  *  *  ATP  5JP>  SET  CORRECT  ATP  *  AND  SCHEDULE  TO  CSADEP 

IF( ITRUCK ( NUMSP  »4 )  .NE.  IATPSIK  4 )  +  75) THEN  3  (4)  IS  CFA  ATP  # 

3  NATP  =  ITRUCK(NUMSP»4>  -  75 
IF( NATP  .NE.  IPARM( 1 ) ) THEN 

WRITE ( 6 . 5  > NUMSP » NATP , IPARM ( 1 ) .TIME 
5  FORMAT ( '  ATP  S*P'»I5.'  REASSIGNED  TO  PARENT  ATp',12. 

*  '  FROM  ASP/ATP', 13.'  TIME'.FS.l) 

END  IF 

NASP  =  IATP(NATP»6> 

IPARM ( 1 )  =  NATP 
IPARMI3)  =  MIX 
IPARM( 4 )  =  0 

CALL  SCHED( 16.IPARM.TIME  +  HITCH)  3CSADEP 
MIXAM  =  ITRIJCK(NUMSP»5)  -  LPPAR(S) 

ICSA(l.MIXAM)  =  ICSA< 1. MIXAM)  +  1  3  INCR  CSA-ATP  AMMO  ISSUED 
RETURN 
END  IF 
C 

C  *  *  *  CFA  ATP  SiPS  —  PUT  IN  QUE 
IF < INITL  .EQ.  1)60  TO  3 
CALL  PUTQUE( NUMSP* 176) 

ITRUCK(NUM3P.3)  =  TIME 
RETURN 
C 

C  *  *  *  ASP  SiP.  CHECK  RECEIVING  ASPS  FOR  GREATEST  AMMO  TYPF  NEEDED 
10  IF < INITL  .EQ.  1 ) GO  TO  35  3  INITIAL  REPLENISHMENT  FDR  THIS  SIP 
C  I  *  LOOP  THROUGH  AIL  RECEIVING  ASPS  (STATUS  =  1> 

C 

ASPPCT  =  100. 

DO  20  AMCODE  =  l.LPPAR(l) 

IF ( IAMLVL( 2* AMCODE)  .EQ.  0)G0  TO  20 
AMPCT  =  100. 

DO  30  ASP  *  1.10 

If <IASP(ASP»2)  .NE.  1)60  TO  30 

C  *  *  ASPPCT  =  (ONHAMD  -  DEMAND  4*  ON-THE-UAY > /STQCKAGE  UB-lECTIVE 

PCT  =  ( IASPf ASP.AMC0DE*3+13)  -  IASP' ASP. AMCODESSil*)  + 

*  I  ASP  ( ASP .  AMCODE  *3+20 ) )  / 1  AML  VL  ( 2 .  AMCO  ri£ ) 

IF (PCT  .LT.  AMPCT ) THEN 

AMPCT  =  PCT 
NLASP  =  ASP 
END  IF 

20  CONTINUE 

IF ( AMPCT  .IT.  ASPPCT ) THEN 
ASPPCT  *  AHF’CT 
NUMASP  =  NLASP 
MIXAM  *  AMCODE 
END  IF 


O  o 


C  *  «  *  IF  ASPPCT  . 3T .  ASP  S  0*  PUT  53P  IN  CSA  QUEUE 
IASPCT  =  ASPPCT 

IF ( I ASPCT  .GT.  IAMLVL( 1 *3Q) ) THEN 
CALL  PUTQUE ( NUMSP  *176) 

ITRUCK(NUMSP*3)  =  TIME 

ICSA(2*31>  *  ICSA (2*31)  r  1  3  INCR  CSA  EMPTY  SIP  SNTP; 

RETURN 
END  IF 

*  *  *  PREPARE  SIP  FOR  CSADEP 

I  TRUCK ( NUMSP  >  4 )  =  NUMASP  +  125 
MIX  =  MIXAM  +  60 
ITRUCK(NUMSP*5'<  =  MIX 
ITRUCN (NUMSP*6)  =  10000 
IPARM(l)  =  NUMASP  +  10 
IPARM<3)  =  MIX 
35  I FARM ( 4 )  =  0 

CALL  3CH£D< 16*IPARM*TIME  +  HITCH)  3  CSADEP 

C 

C  *  *  *  INCR  AMMO  ISSUED  AT  CSA  BY  ONE  SIP  LOAD 
IF'INITL  .EQ.  1 ) THEN 

MIXAM  *  ITRUCK(NUMSP.5>  -  L?PAR<8> 

NUMASP  =  IPARM(l)  -  10 
MIX  *  ITRUCK ( NUMSP * 5 ) 

END  IF 

ICSA(2»MIXAM)  *  ICSA(2*MIXAM)  +  1 
C  *  *  *  INCR  ROUNDS  ON-THE-UAY  AT  ASP 

I  ASP  ( NUMASP i MIXAM  *  3  +  20)  »  IASP( NUMASP*  MIXAM  *  3  +  20)  + 

S  IMIX(MIX»MIXAM) 

C  *  *  *  CHECK  QUEUE  FOR  EMPTY  SIPS 
IF ( ICSA(2*31 )  .LE.  05RETURN 
CALL  GETQUE( NUMSP* 176) 

ICKSP  =  NUMSP 

CALL  PUTQUE (NUMSP* 176) 

CALL  GETQUE< NUMSP* 1765 

IF ( ITRUCK (NUMSP*6)  .EQ,  0 ) THEN 

ICSA(2*3t )  =>  ICSA(2*31)  -  1  3  DECS  CSA  EMPTY  SIP  COUNTER 

GO  TO  10 
ELSE 

CALL  PUTQUE (NUMSP* 176)  3  CSA  SIP  QUEUE 

IF ( ICKSP  .EQ.  NUMSP ) THEN 
ICSA<2*31 )  =  0 
RETURN 
END  IF 
END  IF 

STOP  '  CSAARV  ' 


SUBROUTINE  CSADEP 


SUBROUTINE  CSADEP  ( IPARM ) 

C  EVENT  TYPE  la 

C****  EVENT  CSADEP  —  DEPARTURE  OE  TRUCK  FROM  CSA 

C  ATP  USES  CONVOYS  OE  3  TRUCKS  EACH ,  ASP  USES  CONVOYS  OE  7  TRUCKS 
C  EACH.  TRUCKS  ARE  SCHEDULED  \  MINUTE  AFART. 

C 

C  CALLED  BY  MAINARM 

C  CALLS  OPERA,  INTRDK ,  SCHED,  PUTQUE,  GETOIJE 

C**'**  J.  EOX  JAN  79 
r 

C****  IPARM(l)  —  ATP  NUMBER  OR  ASP  NUMBER 
C'****  IPARM(2)  —  TRUCK  NUMBER 
C»***  IPARM ( 3 )  —  MIX 
C****  IPARM ( 4 )  — 

C 

C****  SCHEDULES  —  ATPAR1 ,  ARRIVAL  OF  TRUCK  AT  ATP 
C  —  A3PAR2,  ARRIVAL  OE  TRUCK  AT  ASP 

C 

C  SCHEDULED  BY  CSAARV 
C 

INCLUDE  LOG, LIST 
DIMENSION  IPARM<5)  ,ISPG(  1.0) 

INTEGER  OWNER 
C 

C ****  LOCAL  VARIABLES  : 

C*»**  LEfTIM  —  TIME  TO  LOAD  TRUCK 

C****  DIST  —  DIST  BACK  TO  ASP  OR  ATP 

C'****  TVLTIM  —  travel  TIME 

C****  ITKTYP  —  TRUCK  TYPE 

C****  TS  —  (TIMF)  SPACE  BETWEEN  TRUCKS  IN  A  CONVOY 
C****  INCONV  —  NUMBER  OF  TRUCKS  TN  A  CONVOY 

C****  NSPCK  —  CHECK  TRUCK  FOR  SiP  S  • 

C***X  TFAIL  --  DELAY  ENROUTE  DUE  TO  FAILURE 
C****  TOTTIM  —  TIME  OF  ARRIVAL  OF  TRUCK  BACK  TO  ATP 
C ****  ISPQO  —  3*P  S  AWAITING  CONVOY 
Cl***  TMIND  —  INTERDICTION  TIME  DELAY 
C 

NUMSP  =  IPARM ( 2 ) 

ITRIJCK(NUMSP,3>  =  TIME 
IF(IPARM(1)  .GT. 10 )G0  TO  TOO 
C  **********  ATP  3£P  *********** 

C 

NATP  =  IPARM(l) 

C 

IF( NATP  . EO .  IATPS0(4))THEN  3  CEA  ATP 
MIX  =  ITRUCK(NUMSP,5) 

NUMAM  =  MIX  -  LF'PAR  (  3 ) 

I  ATP  ( NATP  *  NIJHAM  *  3  +  20)  =  I  ATP  ( NATP ,  NUMA>T  *  3  +  20  > 
t  +  I H I X  <  M I X • NUMAM)  3  ON-THE-UAr  TO  CFA  ATP 

DIST  =  I  ATP  ( NATP,  r, 

ITKTYP  =  ITRUCK ( NUMSP  ,  1 ) 


o  O  O  C~)  o  o  o  o  o  o 


I  TRUCK ( NUMSP » 3 )  =  4 
CALL  INTKDK ( NUMSP » TMINO ) 

IF(TMIND.EO.O. 5  CALL  OPERA <  NUMSP  .  TVLTIM. TFA7L ) 

TOTIM  =  TIME  +  TUi  TIM  +  TFAIL  +  TMIND 
IPARM < 4 )  =  I  TRUCK (NUMSP *5) 

CALL  SCHEDI 10 » IPARM. TOT TM)  3  ATF'AR  1 

RETURN 
END  IF 

*  *  *  INCREMENT  ATP  SJP  COUNTER 

CALL  PUTQUE < NUMSP *  176 ) 

IATP(NATP« 13)  =  IATP(NATPf 13)  +  1 
IF ( IATP(NATP. 13)  .LT.  3) RETURN 

*  *  *  THREE  SSPS  AVAILABLE  FOR  CONVOY 

IATP(NATP> 13)  =  IATP(NATP> 13)  -  3  ?  DORMT  ATP  S*P  CONVOY  COUNT 
I  ATP<  NATP » 17 )  =  IATP(NATP.17)  +  1  3  I  NOR  #  P.F  CONVOYS  ONTR 

DIST  =  IATP(NATP»3) 

INCONV  =  3 
IEVTYP  =  10 
IPARM ( 1 )  =  NATP 
IPARM( 4 )  =  333 

IF ( NATP .  EQ.  IATPSD(4))IPARM<4)  =  0 
OWNER  =  NATP  +  75 
GO  TO  20 

*********  ASP  SJP  **** ********** 

C  *  *  *  INCR  ASP  SIP  CONVOY  CNTR 
C 

100  NASP  =  IPARM ( 1 )  -  10 
CALL  F'UTQIJS  ( NUMSP  f  1 76 ) 

I  ASP ( NASP  >  14 )  =  IASP( NASP .14)  +  1 
IF( I ASP (NASP. 14)  .LT.  7) RETURN 
C  *  *  *  SEVEN  SSPS  AVAILABLE  FOR  CONVOY 
C 

IASP(NASPr 14)  =  I ASP( NASP . 1 4 )  -  7 
I  ASP  ( NASP  *  17  >  =  I  ASP  ( NASP  *  17 )  4-  1 
DIST  =  I ASP (NASP » J ) 

INCONV  =  7 
IEVTYP  =  13 
IPARM ( 1 )  =  NASP  +  10 
IPARM ( 4 )  =  0 
OWNER  *  NASP  +  175 
C 

C  *  *  MOVE  SSF'S  FROM  CSA  QUEUG  TO  CONVOY  (ISPQ)  QUEUE 
20  DO  3  JJ  =  1.10 
ISPQ(JJ)  =  0 
3  CONTINUE 

CALL  GETQUEv NUMSP.  17.4) 

KOIINT = 1 


3-  47 


NSFCK=NUMSP 

CALL  PUTQUE( NSPCK »  1/6) 

13  CALL  GETQUE  ( NIJMSP  1 176) 

IF (ITRUCK ( NUMSP. 4 ) .EQ. OWNER) THEN 
ISPCK  KOUNT )=NUMSP 
IF < NUMSP. EQ. NSPCK) GO  TO  11 
IF ( KOUNT  .EQ.  INCONUlGO  TO  11 
KOUNT  =KQUNT  +  1 
GO  TO  13 
ELSE 

CALL  PUTQUEt  NUMSP  * 17A < 

IF ( NUMSP. FQ. NSPCK) GO  TO  11 
GO  TO  13 
END  IF 
C 

CX***X*X**HAVE  ALL  TRAILERS . FIND  DISTANCE  AND  SCHEDULE 
11  ITKTYP  =  ITRUCK ( NUMSP » 1 ) 

TVLTIM  =  60.XDIST/ITYPE<ITKTYP,IDAY+3> 

TS  ■  1. 

DO  1?  JJ  =  1. KOUNT 
NUMSP  =  ISPQ(.JJ) 

NTIQ  =  TIME  -  ITRUCK ( NUMSP >3 ) 

ITRUCK(NUMSF.12)  =  ITRUCK (NUMSP» 12 >+  NTIQ 

ITRUCK  ( NUMSP  ill)  =  ITRUCK < NUMSP » 1 ) )  +  1  I?  *  TTHFS  AT  CSA 

ITRUCK ( NUMSP  » 3 )  =  4 
TFAIL  =  0. 

CALL  INTRDMNUMSP.TMIND) 

IF(TMIND.EQ.O.)CALL  OPERA (NUMSP * TULTIM. TFATL ) 

TOTIM  =  TULTIM  +  TIME  +  TFAIL  +  TMINP  +  TS 

IPARM(2)  =  NUMSP 

IPARM<3>  =  ITRUCK (NUMSP *5) 

CALL  SCHED( IFVTYP* IPARM» TOTIM)  ®  ATPARl/AS? AR2 

TS=TS+1 . 

12  CONTINUE 
RETURN 


0.  SUBROUTINE  DEMAND 

SUBROUTINE  DEMAND  ( IP ARM) 

C****  EVENT  DEMAND  —  CHECKS  AMMO  DEMAND  OR  UNITS.  RELOAD  IF  NEC? 

C  EVENT  TYPE  1 

C  CALLED  BY  MAINARM 

C  CALLS  RDIEXO(  SCHEDULES  NEXT  Dl-MAND) »  SCHEDf  OPERA 

C 

C****  D.  HILLIS  JAN  79 
C 

Cm*  IF'ARM(l)  —  UNIT  NUMBER 
C 

C*m  SCHEDULES  —  RELOAD.  RESUPPLY  OF  UNITS. 

C  HELARV.  ARRIVAL  OF  HELICOPTER  AT  UNIT 

C  HASPARr  HELI  RETURN  (FAILED  IN  ROUTE) 

C  SCHEDULED  BY  RDIEXO.  RDJIFF(READS  DEMAND  FILE) 

C 

cm*  LOCAL  VARIABLE  DEFINITIONS 
C*m  K  -  UNIT  AMMO  INDEX 

Cm*  NFLAG  -  0  RELOAD  NOT  SCHEDULED  YET.  1  RELOAD  ALREADY  SCHFDUL 

C****  IFLAG  -  0  NORMAL  MODE.  1  -  155  HE  OR  ICM  AMMO  BELOW  ORL 

cm*  I  -  UNIT  NUMBER 

cm*  IA  -  LOOP  INDEX 

Cm*  II  -  LOOP  INDEX 

cm*  TVLTIM  -  ROAD  TRAVEL  TIME 

C*m  TFAIL  -  TIME  LOST  DUE  TO  REMEDIAL  MAINTENANCE 

Cm*  TOTIM  -  TIME  TO  SCHEDULE  THE  EVENT 

C*m  IRRL  -  ROUTINE  RESUPPLY  LEVEL  FOR  LIVE  WPNS 
C*m  IBAM  -  BASIC  AMMO  LEVEL  FOR  LIVE  UPNS 
Cm*  IRGND  -  NO.  RNDS  ON  GROUND  AT  FARP 
C 

INCLUDE  LOG. LIST 
DIMENSION  IPARM ( 5 ) 

C 

NUNIT  =  IPARM ( 1 ) 

NASP  =  I UN  IT (NUNIT .3)  -  10 

C 

CALL  RDIEXO(NUNIT) 

C  INITIALIZE  FLAGS  AND  COUNTERS 
IFLAG  *  0 
NFLAG  =  0 

Cm*  SELECT  AN  AMMO  TYPE 

C 

DO  100  KK  =  1 » LF'PAR  ( a ) 

K  =  KK  *13-5 

IF < I UN  IT (NUNIT ,K) .E3.0  >  GO  TO  100 
IBAM* I UN IT ( NUNIT . K+l >*IUNIT ( NUNIT .  K+7 ) 

Cm*  CHECK  FOR  A  FARP 

I F < I UNIT < NUNIT , 1 ) .EQ.8)  GO  TO  50 
IF(IBAM-IUNIT(NUNIT.Kt4) ,E0.0)  30  TO  100 
cm*  CHECK  FOR  ROUTINE  RESUPPLY 

IRRL*IUNIT (NUNIT  »K+1 )*IUNIT (NUNIT  »K+5: 

IF(I UN IT( NUNIT. K+4).GT. IRRL)  GO  TO  100 
L  =  I  UNIT ( NUNIT . K ) 

P 

w 


49 


IF ( IUKIT  ( fiUMI  T  f  1 ) .  EC1 , 4 ) 


THEM 


C*»** 

C^itl 


C 

Cm* 

35 

C 


r 


CHECK  FOR  AMMO  TYPES  4  AMD  5 

IF «  I  UNIT  (MUM  IT » K )  .EQ.  4  .OR.  I  UNIT  (NUNIT  ;K)  .EG.  3)  THEM 
CHECK  TO  SEE  IF  CURRENT  A«MQ  SUPPLY  GT  CRITICAL  RESUP  LEVEL 
IF  ( IUNIT  (NUiMIT  >Kt4)  .  GT .  IUN I T  ( MUMIT » Kfd  )  *  IUN I T  ( MUM  IT  >  Kr 1 )  .'G0T033 
IFLAG  =  1 
END  IF 
END  IF 


13  THERE  AMMO  OF  THIS  TYPE  ON  TRUCKS 
IF( IUNIT (NUNIT » K  +  3 )  .GT.  0)  THEN 
THERE  IS  AMMO  ON  A  TRUCK 
IF  C  1  FL^G  .EQ.  1)G0  TO  110 
IF ( NFLAG  .EQ.  1 > G 0  TO  100 
SCHEDULE  RELOAD  IMMEDIATELY 

CALL  SCHED(2» IPARMf TIME)  8  RELOAD 


NFLAG  =  1 
ELSE 

Ir ( IFLAG  .EQ.  1)30  TO  150 


END  IF 
GO  TO  100 

C*m  DETERMINE  AMMO  REQUIREMENT  AT  FAR? 

50  IRGND*< IUNITvNUNIT >K44)-IBAM)  K  IUNIT(NUNIT>KP3)  3  CUR  CAP  4  SHRT 
IF ( IRGND  .L£.  0) IRGND  *  0 
IF ( IUNIT (NUN IT »Kt3) .GT. IRGND)  THEN 

IUNIT (NUNIT  >Ki3)*IUNIT (NUNIT  »Kf3)- IRGND 
IRGND  *  0 

IUNIT  (NUNIT  >K+4)  =  I9AM- IUNIT  (NUNIT  iK-PS) 

URITE(LUQUT,210)  IUNIT (NUNIT »K  +  4) > IRGND 
GO  TO  35 
END  IF 

IRGND* IRGND-IUNIT' NUNIT »Kf 3) 

IUNIT ( NUNIT »Kf 4 )  =  IRGNDHBAN 
IUNIT  (NUNIT  *K-r3)=0 


IUNIT ( NUNIT  *KK2 )  =  0 

URITE(LU0UT.210)  IUNIT (NUNIT >Nr4) . IRGND 
210  FORMAT ( '  DMD  -  FARP  0/H=  '»I5r'  ON  GRND*  ' » 15) 

30  TO  100 

Cm*  COMPARE  AVAILABLE  AMMO  AGAINST  CRL 

110  IF  <  IUNIT  (NUNIT  »Kf3)  r  IUNIT  ( NUNIT  «KH )  .GT  .  IUNIT  (  NUNIT  »KP6)* 
2  IUNIT (NUNIT  » K  + 1 )  )  THEN 

IF ( NFLAG  .NE.  1)  THEN 

CALL  SCHED<2» IP ARM » TIME)  3'  RELOAD 

NFLAG  =  1 
END  IF 
IFLAG  =  0 
GO  TO  100 
END  IF 

IF(NFLAG  .EQ.  1)G0  TO  150 

CALL  SCHED(2*IPARM»TIME)  3  RELOAD 

NFLAG  *  1 

Cm*  HELICOPTER  RESUPPLY  LOGIC 

C**«*  DOES  UNIT  ALREADY  HAVE  MAX  NUMBER  OF  HELICOPTERS  ASSIGNED 
130  IF  ( IUN  IT  ( NUNIT » 138 )  .EQ.  2)G0  TO  170 


IF ( IUNIT (NUNIT  > 133;  .EG.  1 > GO  TO  160 
WRITS < LUOUT > 155 ) TIME 

FORMAT ! '  AT  ' ;FS.2;'  MIN.  NO  HELICOPTERS  AVAILABLE 


C  XXX 


C  XXX 


187 

CXXXX 

c 

c 

c 


133 
C  XXX 


STATUS  = 


GO  TO  170 

WRITE (LUOUT  ; 165) TIME 
FORMAT ( '  AT  ';F3.2>'  MIN.  HE LI  SCHEDULED;  NO  OTHERS  As 
IF ( NFLAG  .EQ.  1 ) GO  TO  200 
I FLAG  =  0 
GO  TO  100 

LPPAR(5)  =  LPPAft(5)  -  1 

FIND  AVAILABLE  HELICMISSIGN  =  5.  STATUS  =  2) 

DO  135  II  =  1.LPPARC4) 

IF ( ITRUCK ( 1 1 » 2)  .NE.  5)G0  TO  135 
IF< ITRUCK( 1 1 • 3 )  .EG.  6 > GO  TO  135 
IF ( ITRUCK! II >3)  .EG.  3 > GO  TO  175 
CONTINUE 
WRITE (LUOUT  >186) 

FORMAT ( '  CANNOT  FIND  THE  AVAIL  HELICOPTER -DEMAND 
GO  TO  200 

HAVE  HELICOPTER  II  UPDATE  STATUS 
ITRUCK( II >3)  =  4 

ITRUCK ( 1 1 > ?)  =  ITRUCK( 1 1 ;  9 )  +  1  9  HELI  TRIP  COUN 

SCHEDULE  ARRIVAL  AT  UNIT 
IP ARM (2)  =  II 
FIND  TRAVEL  TIME  TVLTIM 

TVLTIM  =  60.  X  IUNIT (NUNIT >5)  /  ITYPE ( 6 > IDAYf 1 } 

CALL  OPERA ( II >TVLTIM> TFAIL) 

MIX=ITRUCK(II»5) 

TOTIM  =  TIME  +  TVLTIM  +  TFAIL  +  IMIX(MIX>32) 

INCREMENT  ASP  AMMO  ISSUED  BY  ONE  HELI  LOAD 
IASPAM(NASP>?0)  =  IASPAM ( NASP  >  90 )  +  1 
DECREMENT  AMMO  ON  HAND  AT  ASP 
DO  197  IA  =  1 > LPPAR ( 1 ) 

IASP< NASP > IA  *  3  +  13)  =  IASP(NASP>IA  X  3  +  13)  - 
CONTINUE 

IF  HELICOPTER  FAILS  IN  ROUTE  TO  UNIT 
SEND  ANOTHER  HELICOPTER;  IF  AVAILABLE 
SCHED  HELASP 
SET  STATUS  AS  DOWN 
IF (TFAIL  .LE.  0 i 60  TO  198 
ITRUCK (  II  ;3)*6 

CALL  SCHED ( 15; IPARM; TOTIM)  9  HASPAR 

GO  TO  190 

IUNIT ( NUNIT .138)  =  IUNIT ( NUNIT > 133 )  +  1 


9  HELI  TRIP  COUNTER 


ITYPE ( 6 ; IDAY+1 > 


IMIX(MIX;32) 


13)  -  IMIX(MIX.IA) 


HASPAR 


CALL  SCHED ( 14»IPARM;T0TIM)  9  HELARV 

IASP(NASP; 15)  =  I ASP ( NASP ;  15  >  *  1 
I  ASP ( NASP ; 3 )  =  IASP(NASP;3)  +  1 
IF(IUNIT(NUNIT; 138)  .EQ.  2)G0  TO  170 
CXXXX  MIX  91  IS  FOR  THE  CH47  HELICOPTER 

IF ( IMIX <91 ;L)  +  IUNIT( NUNIT  >K  +  4 ) ,GT . IMNIT<  NUNIT. K+e ) X  TUN 
*  K+l ) >  GO  TO  170 

GO  TO  190 


IT ( NUNIT 


p.  SUBROUTINE  BEF'ASF' 

SUBROUTINE  DEPASP < IPARM ) 

C**»*  ROUTINE  DEPASP  REMOVES  A  MLRS  TRUCK  FROM  SERVICE  AT  THE  ASP.  IT 
C ****  CHECKS  FOR  A  MLRS  TRUCK  IN  THE  WAIT  QUEUE  AND  SCHEDULES  AN  ASP 
Cm*  EVENT  IMMEDIATELY  IF  ONE  IS  FOUND, 
r 

C  CALLED  BY  UNTARV 

C  CALLS  GETQUE .  SCHED.  PUTQUE 

C  SCHEDULES  ASP.  ATP 

C 

cm*  L.  IVERSON  DEC  31 
C 

C****  LOCAL  VARIABLES 

C  NUMQ  —  THE  QUEUE  NUMBER  FOR  MLRS  TRUCKS  WAITING  SERVICE 

C  NUMTK  —  THE  TRUCK  NUMBER  OF  THE  TRUCK  FOUND  IN  NUMQ 

C  NCHTK  —  CHECK  TRUCK  FOR  FIRST  TRUCK  IN  QUEUE 

C 

cm*  I  FARM  ( 1 )  =  ASP/ATP  NUMBER 

Cm*  IPARM' 2)  =  0  —  FLAG  THAT  IT  IS  A  MLRS  TRUCK  LEAVING  THE  ASP 
C*m  =  -1  —  FLAG  THAT  IT  IS  A  MLRS  TRUCK  LEAVING  THE  ATP 

C 

INCLUDE  LOG. LIST 
DIMENSION  IPARM<5) 

C 

C*m  REMOVE  THE  TRUCK  FROM  ASP  SERVICE 
IF ( IPARM(2)  .EQ.  -1)  GO  TO  10 
NASP  =  IPARM<1)  -  10 
IASP(NASP»8)  =  IASP(NASP.8)  -  1 
C 

C  *  *  *  *  IF  ASP  INTERDICTED.  DO  NOT  SCHEDULE  MLRS  SERVICE 
IF ( ( NASP  +  10)  .EQ.  ISERV(6)>RETURN 
C 

cm*  CHECK  FOR  ANOTHER  MLRS  TRUCK  TO  LOAD 
NUMQ  =  I  ASF'  ( NASP .  10  ) 

CALL  GETQUE ( NUMTK » NUMO ) 

Cm*  IF  A  TRUCK  IS  FOUND  SCHEDULE  EVENT  ASF' 

IF( NUMTK  .EQ.  0)  RETURN 
IPARM(l)  =  2 
IPARM( 2)  =  NASP  +  10 
IPARM( 3)  =  NUMTK 
IPARM  <  4 )  =  NUMTK 

CALL  SCHED(7. IPARM. TIME)  0  ASF' 

C*m  ADD  ONE  TO  THE  NUMBER  OF  MLRS  TRUCKS  BEING  SERVED 
I  ASF' ( NASF' .  3 )  =  I  ASP  ( NASP .  3 )  +  1 
RETURN 
C 
C 

C  ELSE  MUST  BE  AN  ATP 

C 

10  NATP  »  IPARM < 1 ) 

IATP(NATP»3)  =  IATP(NATP»8)  -  1 

IF\ IATP<  NATP.8)  .LT.  0 ) PRINT* .' DEPASP  NATP , I  ATP (NATP .3 >. TIME 

C 

Cl***  IF  ATP  INTERDICTED.  DO  NOT  SCHEDULE  MI.RS  SERVICE 


3-  53 


MU«Q  =  IATP(NATP.ll) 

CALL  GETQUE ( NUMTK » NUMQ ) 

C***»  SEARCH  FOR  RIGHT  TRUCK 
C  IF  QUEUE  IS  EMPTY  RETURN 
IF  (NUMTK  .  EQ.  0)  RETURN 
NCHTK  =  NUMTK 
CALL  PUTQUE( NUMTK » NUMQ) 

12  CALL  GETQUE ( NUMTK » NUMQ) 

C  DETERMINE  MIX  ON  TRUCK 
MIX  =  ITRUCK  <  NUMTK  »5 ) 

IF  (MIX  .EQ.  10  .OR.  MIX  .EQ.  40)  GO  TO  15 
C  WRONG  TRUCK  PUT  BACK  IN  QUEUE 
CALL  P'JTQUE (NUMTK »NUMQ) 

C  IF  LAST  TRUCK »  RETURN 

IF  (NUMTK  .EQ.  NCHTK)  RETURN 
GO  TO  12 
C 

15  IPARM(l)  =  1 
IPARM ( 2 )  =  NATP 
IPARM<3)  =  NUMTK 
IPARMC4)  =  NUMTK 

CALL  SCHED(6» IPARM > TIME)  3  ATP 

C****  ADD  ONE  TO  THE  NUMBER  OF  MLRS  TRUCKS  BEING  SERVED 
I  ATP ( NATP  »3 ) =  IATP(NATP»8)  +  1 
C 

20  RETURN 


SUBROUTINE  DUALMX 
SUBROUTINE  DUALMX ( I * K * J) 


C 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c**«* 

c 

c«*x* 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 
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RELOADS  MORTARS  AND  3USHHASTERS  FROM  THE  SAHF  TRUCK  UNTIL  BOTH 
ARE  FILLED  OR  THE  TRUCKS  RUN  OUT  OF  AMMO.  THE  SAME  PERCENTAGE 
OF  ROUNDS  WILL  BE  GIVEN  TO  EACH  SYSTEM  DURING  THE  RELOAD. 

CALLED  BY  RELOAD 

CALLS  IQ*  FINTK *  INTRDK »  SCHEB 

SCHEDULES  ASPARV*  DEAD  TRUCK  ->  ASP 
UNTDEP*  RETURNS  UNIT  TRUCK 
IJNTARV* 

L.  IVERSON  NOV  81 

LOCAL  VARIABLES 
I  —  UNIT  NUMBER 

K  —  UNIT  ARRTIBUTE  FOR  MORTAR  AMMUNITION 

J  —  THE  UNIT  ATTRIBUTE  FOR  BUSHMASTER  AMMUNITION 

NDMORT  —  THE  NUMBER  OF  ROUNDS  SHORT  OF  MORTAR  AMMO 

NDBUSH  —  THE  NUMBER  OF  ROUNDS  SHORT  OF  BUSHMASTER  AMMO 

RPMORT  --  THE  PERCENT  OF  A  TRUCK  LOAD  OF  MORTAR  AMMO  NEEDED 

RPBUSH  —  THE  PERCENT  OF  A  TRUCK  LOAD  OF  BUSHMASTFR  AMMO  NEEDED 

NUM1  —  THE  UNIT  ATTRIBUTE  OF  THE  MOST  NEEDED  AMMO  (J  OR  K) 

NUM2  —  THE  UNIT  ATTRIBUTE  OF  THE  OTHER  AMMO 

ND1  —  THE  NUMBER  OF  ROUNDS  NFEDED  TO  FILL  THE  GREATEST  DEMAND 

ND2  —  THE  NUMBER  OF  ROUNDS  TO  BE  GIVEN  TO  THE  OTHER  WEAPON 

NUMQ  —  THE  QUEUE  NUMBER  FOR  UNIT  TRUCKS 

NUMTK  —  THE  NUMBER  OF  THE  TRUCK  TAKEN  FROM  NUMQ  TO  FILL  NEED 

TMIND  —  THE  DELAY  TIME  ASSESSED  FOR  A  TRUCK  INTERDICTION 

L0AD1  —  THE  AMOUNT  OF  THE  MOST  NEEDED  AMMO  ON  THE  TRUCK  NUMTK 

L0AD2  —  THE  AMOUNT  OF  THE  OTHER  AMMO  ON  THE  TRUCK 

NEULD1  --  THE  ROUNDS  FROM  TRUCK  NUMTK  TO  LOAD  ON  THE  WEAPON  SYSTEM 

NEWLD2  —  THE  ROUNDS  TO  LOAD  ON  THE  OTHER  WEAPON 

KIND  —  THE  EVENT  NUMBER  1  3  *  UNTDEP*  8  =  UNTARV 

NRPW1  —  THE  ROUNDS  LOADED  ON  EACH  WEAPON  OF  TYPE  NUM1 

NRPW2  —  THE  ROUNDS  LOADED  ON  EACH  WEAPON  OF  TYPE  NUM2 

NW1  —  THE  NUMBER  OF  WEAPONS  LOADED*  TYPE  NUM1 

NW2  —  THE  NUMBER  OF  WEAPONS  LOADED*  TYPE  NUM2 

INCLUDE  LOG.LIST 
DIMENSION  IPARM(5) 

FIND  THE  AMMO  TYPE  WITH  THE  LARGEST  DEMAND  -  NUM1 
NDMORT  »  IUNIT ( I *N+7)  *  IUNIT  < I  *  K  +  l )  -  IUNIT(I*K  +  4) 

NDBUSH  »  IUNIT ( I  * J+7)  *  IUNIT ( I  *  J+l )  -  IUNITCI* J+4) 

RMIX16  ■  IMIX ( 16*16) 

RMIX17  =  I M I X ( 16* 17) 

RPMORT  =  NDM0RT/RMIX16 
RPBUSH  »  NDBUSH/RMIX17 
IF (RPMORT  .GT.  RPBUSH)  THEN 
NUM1  a  K 
NUM2  »  J 
ND1  *  NDMORT 


NUM’  =  J 
NUM2  =  K 
ND1  =  NDBUSH 
ND2  =  RMIX16  *  RPBUSH 
END  IF 
C 

URITE(LU0UT»20)IUNIT(I»NUMl),NDl, IUNIT< I.NUM2)  »ND2 
20  FORMAT ( '  RELOAD  AMMO  TYPES  '»4I5»'  ROUNDS') 

C***#  PULL  TRUCK  FROM  QUEUE 
NUMQ  =  IQ(l.I) 

30  CALL  FINTK  (  NUMQ» 16  > NUMTK >  0 ) 

URITE(LU0UT,40)NUMTK 
40  FORMAT ( '  .scLOAD  AFTER  FINTK  SI5) 

IF( NUMTK  .EQ.  0)  RETURN 
C**«*  CHECK  FOR  INTERDICTION 
CALL  INTRDK ( NUMTK  f  TMIND ) 

IF ( TMIND  .NE.  0)  THEN 

C  #*#*  ADD  ONE  TO  THE  NUMBER  OF  TRUCKS  KILLED  DURING  RELOAD 

JUNIT( IUNIT < I » 1 ) >23)  =  JUNIT ( IUNIT ( I > 1 ) »23)  +  1 
C  DECREMENT  UNIT  AMMO  ON  TRUCKS 

IUNIT < I » J+8)=IUNIT ( I* J+8)-( IMIX( 16r 17)*ITRUCK(NUMTK»o)+9999 )/10000 
IUNIT(IfK+8)=IUNIT(I»K+8)“(IMIX( 16> 16 ) *ITRUCK (NUMTK»6)+99?9)/10000 
IPARM(l)  =  I 
IPARM(2)  *  NUMTK 
IPARM( 4 )  =  16 

C  SCHEDULE  ASPARV  FOR  KILLED  TRUCK 

CALL  SCHED<5»IPARMf TIME  +  TMIND)  0  ASPARV 

ITRUCK(NUMTK»6)  =  0 
GO  TO  30 
END  IF 
C 

C ****  CALCULATE  THE  TRUCK  AMMO  LOAD  FOR  AMMO  TYPE  NUM1  AND  N1JM2 

L0AD1  *  ( IMIX( 16> IUNIT ( I rNUMl ) ) *ITRUCK( NUMTK*  6) +9999) /1 0000 
L0AD2  *  ( IMIX  ( 16 » IUNIT  ( I  >  NUM2)  )4sITRUCK(  NUMTK  ?  6 )  +9999 )/ 10000 
Ctttt  CHECK  DEMAND  AGAINST  LOAD 
IF ( ND1  .GE.  L0AD1)  THEN 
NEULD1  *  LOA'Dl 
NEULD2  =  L0AD2 
ITRUCK(NUMTK»6)  =  0 
KIND  =  3 
ELSE 

NEULD1  =  ND1 
NEULD2  =  ND2 

ITRUCK(NUMTK>6)  =  10000  *  (L0AD1-ND1 )/IMIX(16»IUNIT(I» NUM1 ) ) 
KIND  *  8 
END  IF 

IF< ITRUCK(NUMTK»6)  .LE.  1000 ) THEN 
NEWLD1  =  L0AD1 
NEWLD2  =  L0AD2 


ITRUCK(NUMTK»6)  =  0 
KIND  =  3 
END  IF 

C****  CALCULATE  THE  UNLOAD  TIME »  FIND  ROUNDS  PFR  UPN  AND  NUM  UPNS 


NRPW1  =  MD1  /  I'JNIT  ( I » NUM1+2 ) 

END  IF 

IF(IUNIT(I» MUM2+2)  .EQ.  0)  THEN 
NRPU2  =  1 
ELSE 

NRPW2  =  ND2  /  I UN  I T ( I >  NUM2+2) 

END  IF 

IFtNRPWl  .LE,  0)  NRPW1  =  1 
IF ( NRPI42  .LE.  0)  NRPW2  =  1 
NU1  =  MIN0(L0AD1/NRPW1f IUNIT< IfNUM1+2)  > 

NU2  *  MIN0(LQAD2/NRPW2f IUNIT( I t NUM2+2) ) 

DELAY  =  2  *  IRSTME(1of3>  .+  (NW1  +  NW2 )  *  < IRSTMEI 16»1> > 
IF ( NUM1  .EQ.  J)THEN 

DELAY  =  DELAY  +  NEULD2  *  IRSTME< 16f2>/100 
ELSE 

DELAY  =  DELAY  +  NEULD1  *  IRSTMFt  16»2)/10C* 

END  IF 

C****  SEND  THE  TRUCK  OUT 
IPARM(l)  *  I 
IPARMC2)  =  NUMTK 

CALL  SCHED(KINDfIPARMfTIME  +  DELAY)  3  UNTDEP/UNTARV 

ITRUCK(NUMTKfII)  *  ITRUCK ( NUMTKf 11 )  +  1  0  RELOAD  COUNTER 
ITRUCK(NUNTKi3)  a  0 

C**«  ADJUST  AMMO  ON  TRUCKS  AND  CURRENT  ANNO  SUPPLY 
IUNIT<IfNUM1+8)  a  IUNIT ( I fNUMI+8 )  -  NEULD1 
IUNIT<  IfNUN2+8)  =  IUNIT <  I  »NUM2-F8)  -  NEULD2 
IUNIT( I » NUM1+4 )  »  IUNIT < I f NUN1+4 )  +  NEULD1 
IUNIT ( I fNUM2+4)  =  IUNIT ( I fNUM2+1)  +  NEWLD2 
C****  DECREMENT  THE  NUMBER  OF  ROUNDS  SHORT 

IUNIT(I»NUMl+3)  =  IUNIT ( I »NUMl+3>  -  NEULD1 
IF ( IUNIT ( I ?NUMl+3)  .LT.  0 ) IUNIT( I fNUM1+3)  =  0 
IUNIT ( I f NUM2  +  3)  =  IUNIT( I f NUM2+3)  -  NEULD2 
IF(IUNIT(IfNUM2+3)  .LT.  0 ) IUNIT( I fNUM2+3)  a  0 
IUNIT(IfNUM1+2)  =  IUNIT(IfNUM1+2)  -  NU1 
IF(IUNIT(IfNUM1+2)  .LT.  0)  IUNIT< I » NUMi+2)  =  0 
IUNIT ( I .NUM2+2)  =  IUNIT ( I fNUM2+2)  -  NW2 
IF(IUNIT(I fNUM2+2)  .LT.  0)  IUNIT(IfNUM2+2)  =  0 
C***#  ADD  THE  DELAY  TIME  TO  THE  TOTAL  UNIT  RELOAD  TIME 

JUNIT(IUNITUfI)  f21>  =  JUNIT(IUNIT(If1)f21)  +  DELAY 
IF(IUNIT(IfNUM1+7)*IUNIT(IfNUM1+1)-IUNIT(IfNUM1+4) .GT.O) 

c 

RETURN 


o  n  o 


SUBROUTINE  EDITB 
SUBROUTINE  EDITB 

*:*:«*  ALLOWS  EDITING  OF  DATA  IN  COMMON  LOG 

CALLED  BY  EDIT,  CONTRL ( THE  EDIT  OR  ARM  MENDS) 

CALLS  READF 

C*X**  H.  JONES  FEB  7? 

C**»*  NOTE  ALL  VARIABLES  IN  COMMON  LOG  ARE  2  DIMENSIONAL 

CHARACTERXIO  AUNIT,  NAME,  IWORD,  IFND 
COMMON  /LOG/  I ATP < 10 * 53 ) »  I ASP < 10 » 1 10 > ,  IUNIT ( 75, 142) , 

*  ITRUCK( 1400, 15) ,  ITYPE<9,6>,  IMIX(91,32),  INTER ( 1 , 10 > , 
i  IRSTME<23,3),  IATPSD(1*5>* 

5  I DAY (1,1),  TIME ( 1 » 1  > ,  IATPAM( 10,40) ,  IC3A(3,32>*  LPPARi 1 , 10 ) , 

$  IASPAM (10,120) ,  LUOUT (1,1),  TCIST(1,1),  T C I L N G < 1,1) ,  LOOK (1,19; 
i  , JUNIT( 3 , 24 ) , JATP ( 10 , 6) , JASP< 10 , 9 ) 

*  , IATPSP (10,22), I ASPSP (10,30) , IAHLVL  <2*30), ISERV (1,10) 

COMMON  /  AlJNIT  /  AUNIT(75,2> 

DIMENSION  INTGR(IO),  REAL(IO),  IUORD(IO) 

INTEGERS  SKIP 

DIMENSION  NAME (27) ,  LIMITK27),  LIMIT2(27> 
r 

DATA  NAME  /'IATP',  'IASP',  'IUNIT',  'ITRUCK',  ' I  TYPE' , 

$  ' IMIX ' ,  'INTER',  ' IRSTME' »  'IATPSD',  'IDAY', 

i  'TIME',  '  IA  TPAM '  ,  ' ICSA ' ,  'LPF’AR' ,  'IASPAM',  'LUOUT',  'TCIST' 
$  ' TCILNG ' ,  'LOOK',  ' AUNIT' , 'JUNIT' , 'JATP' , 'JASP'  , 

5  ' IATPSP' , 'I ASPSP' , ' IAMLUL' , ' ISERV'/ 

C 

DATA  LIMIT1  /10,  10,  75,  1400,  9, 

*  91 ,  1 ,  23,  1 ,  1 , 

*  1,  10,  3,  1,  10,  1,  1,  1,  19,  75,  8,  10,10,10,10,2,1/ 

C 

DATA  LIMIT2  /53,  110,  142,  15,  a, 

*  32,  10,  3,  5,  1, 

*  1,  40,  32,  10,  120,  1,  1,  1,  1,  2,  24,  6,  9,22,30,30,10/ 

DATA  IEND/'END'/ 

NNAME3  =  27 
LU1  =  5 
LEAP  =  l 
SKIP  =  1 
C 

10  WRITE(6,120> 

CALL  READF  (LU1,  10-  INTGR,  REAL,  IWORD) 

C 

Ctttt  BRANCH  ON  DATA  TYPE 

20  IF ( I  WORD ( 1 )  ,EQ.  IEND)  GO  TO  110 
DO  30  KTYPE  =  1 « NNAMES 
IF ( IUORD( 1 )  . EQ.  NAME(KTYPE) )  GO  TO  40 
30  CONTINUE 
GO  TO  10 
C 

C ****  SET  LIMITS  FOR  DATA  TYPE 
40  ILOW  =  INTGR(l) 

IHIGH  »  INTGR(2) 

IFLG  =  0 

IF ( ILOW  .EQ.  0  .AND.  IHIGH  .EG).  0)  IFLG  =  1 


IF(  IFLG  .EQ.  1)  IHIGH  =  LIMIT1  (KTYPE) 

IF< IHIGH  .EQ.  0)  IHIGH  *  ILOW 

IF  (IHIGH  .GT.  LIMIT1 (KTYPE) )  IHIGH  =  LIMIT1  (KTYPE) 

IF < ILQU  .GT.  LIMIT1 (KTYPE) )  GO  TO  10 
C 

C'tfit  BACKGROUND  HAS  BEEN  SET*  READ  CHANGE  OR  LIST  COMMAND 
50  WRITE<6*140) 

CALL  READF  (LU1*  10*  INTGR *  REAL*  IUORD) 

IF ( I WORD ( 1 )  .EQ.  'LIST'  .OR.  IUORD(l)  .EQ.  'L')  GO  TO  SO 
IFdUORD(l)  .EQ.  'CHANGE'  .OR.  IMORD(l)  .EQ.  'C')  GO  TO  90 
IF(IM0RD(1)  .EQ.  'LEAP' )THEN 
LEAP  =  INTGRd) 

GOTO  50 
ELSE 

IF ( lUORDd )  .EQ.  'SKIP'  )THEN 
SKIP  =  INTGRd) 

GOTO  50 
END  IF 
END  IF 
GO  TO  20 
C 

C****  LIST  COMMAND 
SO  IATT1  =  INTGRd) 

IATT2  *  INTGR (2) 

IFLG  =  0 

IFdATTl  .EQ.  0  .AND.  IATT2  .EQ.  0)  IFLG  =  1 

IF ( IFLG  .EQ.  1)  IATT1  =  1 

1F( IFLG  .EQ.  1)  IATT2  *  LIMIT2(KTYPE) 

IF( IATT2  .EQ.  0)  IATT2  *  IATT1 

IF( IATT2  .GT.  LIMIT2(KTYPE) )  IATT2  *  LIMIT2(KTYPE> 

C 

IFdATTl  .GT.  LIMIT2< KTYPE) )  GO  TO  50 

DO  80  INDEX  =  ILQUi  IHIGH*  LEAP 

URITE(S, 150)  NAME(KTYPE) *  INDEX 

DO  30  IATT  =  IATT1 *  IATT2*  SKIP 

IF  (KTYPE  .E-Q.  1)  IVALUE  *  IATP(  INDEX*  IATT) 

IF<  KTYPE  .EQ.  2)  IVALUE  =  IASP( INDEX  *  IATT) 

IF (KTYPE  .EQ.  3)  IVALUE  =  IUNIT< INDEX  *  IATT) 

IF( KTYPE  .EQ.  4)  IVALUE  »  ITRUCK ( INDEX  *  IATT) 

IF ( KTYPE  .EQ.  5)  IVALUE  =  ITYPE( INDEX  *  IATT) 

IF(KTYPE  .EQ.  S)  IVALUE  =  IMIXdSDEX*  IATT) 

IF(KTYPE  .EQ.  7)  IVALUE  =  INTER( INDEX  *  IATT) 

IF(KTYPE  .EQ.  3)  IVALUE  *  IRSTME( INDEX*  IATT) 

IF( KTYPE  .EQ.  9)  IVALUE  =  IATPSD( INDEX, IATT) 

IF(KTYPE  .EQ.  10)  IVALUE  =  IDAYdNDEX* IATT) 

IF(KTYPE  .EQ.  ID  IVALUE  *  TIME( INDEX  * IATT ) 

IF( KTYPE  .EQ.  12)  IVALUE  *  I ATP AM (INDEX, I ATT) 

IF ( KTYPE  .EQ.  13)  IVA..UE  =  ICSA<  INDEX.  IATT ) 

IF(KTYPE  .EQ.  14)  IVALUE  =  LPPAR ( INDEX  * IATT ) 

IF (KTYPE  .EQ.  15)  IVALUE  =  IAS?AM( INDEX* IATT) 

IF ( KTYPE  .EQ.  IS)  IVALUE  =  LUOUT( INDEX  * IATT) 

IF( KTYPE  .EQ.  17)  IVAUJE  *  TCIST( INDEX  * IATT) 

IF<  KTYPE  .EQ.  18)  IVALUE  *  TCILNG( INDEX  * IATT) 

IF ( KTYPE  .EQ.  19)  IVALUE  *  LOOK( INDEX  * IATT ) 


UR ITE(6»210>  I  ATT  »  AUNIT (INDEX  , 1  ATT ) 

GO  TO  50 
END  IF 

IF (KTYPE  .£0.  21)  IVALUE  =  JUNIT ( INDEX. IATT) 
IF ( NTYPE  .Efl.  22)  IVALUE  =  JATF'(  INDEX#  IATT) 

IF ( KTYPE  .EQ.  23)  IVALUE  =  JASF' ( INDEX  ,  IATT ) 

IF ( KTYPE  .EQ.  24)  IVALUE  =  IATPSP ! INDEX , IATT ) 
IF ( KTYPE  .EQ.  25)  IVAl UE  =  IASPSP ( INDEX.IATT ) 
IF ( KTYPE  .EQ.  26)  IVALUE  =  IANLVL ( INDEX , IATT ) 
IF< KTYPE  .EQ.  27)  IVALUE  =  ISERVI INDEX , IATT) 
IF (KTYPE  . L£ .  0  .OR.  KTYPE  .GT.  27)G0  TO  40 
C 

70  URITE( 6. 160 )  IATT.  IVALUE 
30  CONTINUE 
GO  TO  50 

55  WRITE<6»210)  IATT.  AUNIK INDEX. IATT) 

GO  TO  50 
C 

c 

C**:**  CHANGE  COMMAND 
90  IATT  =  INTGR(l) 

VALUE  =  INTGR ( 2 )  +  REAL  < 1 ) 

IF ( IATT  .GT.  LIMIT2(KTYPE) )  GO  TO  50 
C 

DO  100  INDEX  =  ILOW.  IHIGH.  LEAP 
C  INSERT  VALUE  IN  PROPER  ARRAY 

IF < KTYPE  .EQ.  1)  IATP< INDEX.  IATT)  =  VALUE 
IF  (KTYPE  .EQ.  2)  IASPUNDEX.  IATT)  *  VALUE 
IF (KTYPE  .EQ.  3)  IUNIT ( INDEX »  IATT)  *  VALUE 
IF ( KTYPE  .EQ.  4)  ITRUCM INDEX.  IATT)  =  VALUE 
IF ( KTYPE  .EQ.  5)  ITYPEC INDEX.  IATT)  =  VALUE 
IF< KTYPE  .EQ.  6)  IMIX( INDEX .  IATT)  =  VALUE 
IF ( KTYPE  .EO.  7)  INTER< INDEX.  IATT)  *  VALUE 
IF < KTYPE  .EQ.  S)  IRSTME ( INDEX .  IATT)  =  VALUE 
IF ( KTYPE  .EQ.  9)  I  ATPSDIINDEX,  IATT)  =  VALUE 
I F < KTYPE  .EQ.  10)  IDAY( INDEX. IATT)  =  VALUE 
IF(KT(P£  .EQ.  11)  TIME(  INDEX .  IATT )  =  VALUE 
IF (KTYPE  .EQ.  12)  IATPAMt INDEX. IATT)  =  VALUE 
IF (KTYPE  .EQ.  13)  ICSA( INDEX. IATT)  =  VALUE 
IF (KTYPE  .EQ.  14)  LPPARI INDEX.IATT)  =  VALUE 
IF (KTYPE  .EQ.  15)  IASPAMI INDEX.IATT)  =  VALUE 
IF ( KTYPE  .EQ.  16)  LUOUT< INDEX . I  ATT)  =  VALUE 
IF ( KTYPE  .EQ.  17)  TCISTi INDEX. IATT)  =  VALUE 
IF < KTYPE  -EQ.  13)  TCILNGv INDEX. IATT)  *  VALUF 
I F ( KTYPE  .EQ.  19)  LOOK ( INDEX . IATT )  =  VALUE 
IF ( KTYPE  .EQ.  20 ) THEN 
URIT£<  6 » 200 ) 

READ (5. 130)  IU0RD(2) 

AUNIT ( INDEX » IATT)  =  IW0RIK2) 

END  IF 

IF< KTYPE  .EQ.  21)  JUNITt INDEX, IATT)  =  VALUE 
IF < KTYPE  .EQ.  22)  JATP( INDEX, IATT)  =  VALUE 
IF (KTYPE  .EQ.  23)  JASPI INDEX, IATT)  *  VALUE 
IF( KTYPE  .EQ.  24/  IATPSP ( INDEX, IATT )  =  VALUE 


o  o  o 


SUBROUTINE  ENDSIM 
SUBROUTINE  ENDSIM* IPARM) 

C  EVENT  TYPE  19 

C****  SIMULATION  END 
C 

C  WRITES  FILE  4  (THE  TDATABA3E  FOR  THE  NEXT  Cl'-. 

C 

C  CALLED  BY  MAINARM 

C  SCHEDULED  BY  CONTRL ,  INIT 

****  H.  JONES  FEB  79 

CHARACTER*10  AUNIT 
INCLUDE  LOG, LIST 
INCLUDE  QU£NUM,LIST 
INCLUDE  QUEPNT f LIST 
INCLUDE  AUNIT, LIST 
DIMENSION  IPARM(5) 

C 

WRITE* 4)  IATP , IASP, IUNIT , I TRUCK, I TYPE t IM IX, INTER, IRSTME , 

Z  IATPSD, IDAYtTIME, IATPAM, ICSA,LPPAR , IASPAMrLUOUT , TCIST , 

Z  TCILNG,  LOOK,  IHEAD,  ITEMS,  AUNIT,  JUNIT,  JATP,  JASP,  . 

Z  IATPSP, IA3PSP, IAMLVL, ISERV 

C 

C*#**  WRITES  TERMINATION  MESSAGE 

IF(IPARM(1)  . EQ •  9999)  URITE(6»10)  TIME  9  NORMAL 

IF(IPARMU)  .EQ.  8838)  URITE(6,11)  TIME  0  ABNORMAL 

10  FORMAT (IX, 'SCHEDULED  STOP,  TIME  *  ' »F8.1*//»1X, 'SSH  ARMPL.FRK 

Z  THEN  SSG  ARMPL.EDITYES' ) 

11  FORMAT ( IX, ' STOP  SIIMULATION  FROM  CONTROL,  TIME  =  ',F8.D 

C 

RETURN 


SUBROUTINE  EVSTOP 
SUBROUTINE  EVSTOP 
C  CALLED  BY  iiAINARH 

C*«*  WRITES  UNUSED  EVENTS  ON  THE  EVENTS  FILE  FOR  THE  NEXT 
C****  EVTCI — .  (FILE  3) 

C.m*  H.  JONES  FEB  7? 

C 

INCLUDE  EVENTSjLIST 
URITE<3)  JSTAT >  JEVDS*  IEVS 
C 

RETURN 

END 
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u.  SUBROUTINE  FINTK 

SUBROUTINE  FINTK  ( NGUE >  NUMAM,  NUMTK,  MINMAX ) 

C****  DETERMINES  NUMBER  OF  TRUCK  ( NUMTK )  IN  QUEUE  ( NQUE )  HAS 
C***'*  THE  SMALLEST  PERCENTAGE  LOAD  OF  ROUNDS  OF  TYPE  (NUrtAM) 

CX***  JIM  FOX  JAN  79 

r* 

U 

C  CALLED  BY  ASP?  ASPAR1,  ATP »  ATF'ARV ,  DUALMX »  LDPWDR,  RELOAD.  SERVE 
C  CALLS  GETQUE.  P'JTQUE 
C 

Mc*t££  |  nr  ai  UAPTARI  FQ* 

C**»*  ITRCK  —  SAVES*TRUCK  NUMBER  WITH  THE  SMALLEST  LOAD 

C**X*  NPERSV  —  SMALLEST  PERCENT  FOUND 

C***X  NCHTK  —  END  OF  QUEUE  CHECK 

CX***  MIX  —  AMMO  MIX  INDEX 

Cm*  MINMAX  —  0»  FIND  TRUCK  WITH  SMALLEST  LOAD 

C  1.  FIND  TRUCK  WITH  LARGEST  LOAD 

C 

INCLUDE  LOG. LIST 
C***X  INITIALIZE  AMMO  PERCENT 
IF< MINMAX  .EQ.  0 )THEN 
NPERSV  =  10010 
ELSE 

NPERSV  =  0 
END  IF 
C 

cm*  ASSUME  NO  TRUCK  WITH  PROPER  AMMO 
NUMTK  =  0 
C 

Cl***  BRING  FIRST  TRUCK  FROM  QUEUE  (ITRCK) 

CALL  GETQIJE  (ITRCK,  NQUE) 

C 

C*m  IF  QUEUE  IS  EMPTY  RETURN 
IF( ITRCK  .EQ.  0)  RETURN 

r 

C****  THERE  ARE  SOME  TRUCKS  IN  QUEUE 

CXXXX  SEARCH  FOR  RIGHT  TRUCK,  STORE  NCHTK  AND  PUT  IT  BACK  IN  QUEUE 
NCHTK  *  ITRCK 
CALL  PUTQUE( ITRCK ,  NQUE) 

C 

cm*  PULL  TRUCK  FROM  QUEUE 
25  CALL  GETQUE( ITRCK, NQUE) 

C 

C****  DETERMINE  AMMO  MIX  TYPE 
MIX  =  ITRUCK( ITRCK,  5) 

LOAD  =  I  TRUCK (ITRCK, 6) 

C  IF  THIS  TRUCK  HAS  THE  DESIRED  LOAD,  THFN  KEEP  TRACK  IN  NUMTK. 

C*m  IF  RIGHT  AMMO  COMPARE  LOAD  SIZE)  IF  NOT  GO  TO  CHECK  END  QUEUE 
IF ( IMIX ( MIX ,  NUMAM)  .GT.  0)  THEN 

IF< MINMAX  .EQ.  0  .AND.  LOAD  .LE.  NPERSV  .OR. 

$  MINMAX  .GE.  1  .AND.  LOAD  ,GF .  NPERSV)  THEN 

IF ( ITRUCK ( ITRCK , 6 )  .NE.  0)  THEN 

IF (NUMTK  .NE.  0)  CALL  PUTQUE( NUMTK,  NOUE ) 

NPERSV  =  ITRUCK  < ITRCK , 6 ) 

NUMTK  =  ITRCK 
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RETURN 
END  IF 
END  IF 
END  IF 

CMM  WRONG  TRUCK,  PUT  BACK  IN  QUEUE 
CALL  PUTQIJE <  ITRCKrNQUE) 

C 

CM**  IF  LAST  TRUCK ,  RETURN 

IF < ITRCK  .NE.  NCHTK )  GO  TO  25 
C 

CM**  HAVE  FOUND  CORRECT  AMMO  CHECK  TO  SEE  IF  SHOULD  BF  SAVED 
RETURN 


r~>  o  o  o  (i  o  ~i  o  o  o  o  n  n 


V 


SUBROUTINE  GETEVT 
SUBROUTINE  GETEVT ( IEVT • ITH. ITS ) 
GETS  NEXT  EVENT  (FROM  EVENT  QUEUE) 


C 


CALLED  BY  NEXTEV.  WHICH  RETURNS  THE  EVENT  TO  MA3  NAfiM. 

GETEVT  DOES  NOT  CALL  ANYTHING. 

RETURNS  IEVT < 5 )  —  THE  FARMS  FOR  THE  NEXT  EVENT  IN  QUEUE. 

ITH  —  EVENT  TIME »  IN  WHOLE  MINUTES. 

ITS  —  THE  FRACTIONAL  FART  OF  EVENT  TIME(MIN  *  3600) 

BOB  DAVISON 

INCLUDE  EVENTS. LIST 

DIMENSION  IEVT(5)»JF0RE(2048)*JBACK(2048) 

EQUIVALENCE  (JFORE(l)f JEVDS< 1 » 1 > ) . < JBACK(l). JEVBS<1.2> >  » 

2  (JFIRST. JSTAT(l) ) . < JLAST. JSTAT<2> ) . < JEMPTY. JSTAT(3) > » 

Z  ( NUMEVT  » JSTAT(4) ) » (NEMPTY» JSTAT (5) ) . (MAXEVT » JSTAT ( 6) ) 

CHECK  IF  AN  EVENTS  IN  QUEUE  ...  IF  NONE*  RETURN 


DO  20  IN  =  1 » 5 

IEVT (IN)  *  IEVS( IN. JFIRST) 
20  CONTINUE 

ITH  =  JEVDS  (JFIRST. 3) 

ITS  =  JEVDS  (JFIRST. 4) 
IF(NUMEVT.LE.O)  RETURN 
C 

NEXT  *  JFQRE( JFIRST) 

JFORE  (JFIRST)  =  JEMPTY 
JEMPTY=JFIRST 
IF(NEXT.LE.O)  NEXT  =  1 
JBACN(NEXT)  =  0 
JFIRST  =  NEXT 
NEMPTY  =  NEMPTY  +  1 
NUMEVT  =  NUMEVT  -  1 
C 

RETURN 

END 


8  PARMS  FOR  THE  NEXT  EV 


8  ADD  THIS  NODE  TO 
8  THE  EMPTY  EVENT  LIST 


6a 


SUBROUTINE  GETQUE 
SUBROUTINE  GETQUE  ( ITEM*  NUHQIJE) 

C  GETS  'FIRST  ITEH  IN  QUEUE'  FROM  NUHQUE 
C  TO  GET  TRUCK  FROM  QUEUE  4  —  CALL  GETQUE  <N*4) 

C  VEHICLE  NUMBtR  IS  RE7RUNED  IN  ITEM 
C 

C  CALLED  3T  ASPAfil *  ASPAR2.  ASPARV*  ATPARV*  CSAARV*  C3ADEF' • 

C  DEPASP*  FINTN t  SERVER  (EDIT  PROliMJ  EDIT »  PRINT*  TRKPUT 

C  CALLS  NONE 
Ztttt  H.  JONES  DEC  78 
INCLUDE  QUENUM.LIST 
INCLUDE  QUEPNT *LIST 
ITEM  »  0 
LITEM  »  0 
C 

IF(NUMGUE  *LE .  0  .OR.  NUHQUE  .GT.  176)  THEN 
PRINT** 'BAD  QUEUE  NUMBER  IN  GETQUE...' 

RETURN 
END  IF 

IPOINT  *  IrlEAD  ( NUHQUE ) 

C  SEARCH  QUEUE  FOR  FRONT 

10  IF ( IPOINT  .EQ.  0)  GO  TO  20 
LITEM  a  HEM 
ITEM  =  IPOINT 
IPOINT  a  ITEMS( ITEM) 

GO  TO  10 
C 

20  IFtLITEM  .GT.  0)  ITEMS(LITEM)  =  0 
IF(LITEM  .EQ.  0)  IHEAD(NUMQUE)  *  0 
C 

RETURN 


SUBROUTINE  HASPAR 
SUBROUTINE  HASF’AR  !  I  FARM ) 

C:nt*  EVENT  HASPAR  —  ARRIVAL (RETURN)  OP  HELICOPTER  BACK  AT  ASP . 

C  EVENT  TYPE  15 

C  CALLED  BY  MAINARM 

C  CALLS  NOTHING 

C 

C#***  J.  POX  JAN  79 
C 

C****  IPARM(l)  ~  UNIT  #( IF  SCHED  BY  DEMAND) »  A3P#(IF  SCHED  BY  HEi  ARV 
C**»*  IPARM( 2)  —  HELICOPTER  NUMBER 

C 

C**S#  SCHEDULES  --  NOTHING 

C Xttt  SCHEDULED  BY  DEMAND >  HELARV 

C 

C*«*»  CHANGES  NUMBER  OF  HELOS  IN  USE(LPPAR(5) ) . 

C 

INCLUDE  L06»LIST 
DIMENSION  IPARM(5) 

£ 

C  LOCAL  VARIABLES 

C  NHELI  —  HELICOPTER  NUMBER  FROM  ITRUCK  ARRAY 
C 

C:m**X  INCREMENT  NUMBER  OF  HELICOPTER  AVAILABLE  FOR  USE 
LPPAR<5)  *  LPPAR<5)  +  1 

C 

NHELI  =*  IPARM<2) 

C 

C******  CHANGE  STATUS  TYPE 
ITRUCK  (NHELI >3)  =  3 

C  HELI  KEPT  FULL 

ITRUCK  (NHELI »A)  =  10000 
RETURN 
END 


SUBROUTINE  HELARV 
SUBROUTINE  HELARV  (IPARM) 

C**»*  EVENT  HELARV  —  ARRIVAL  OF  HELICOPTER  AT  UNIT 
C  FOR  EMERGENCY  RESUPPLY  OF  ARTY. 

C  EVENT  TYPE  14 
C  CALLED  BY  MAINARM 
C  CALLS  OPERA.  SCHED 
C 

C'****  J.  FOX  JAN  79 
C 

C****  IPARH(l)  —  UNIT  NUMBER 
C***»  IPARM< 2)  —  HELICOPTER  NUMBER 

C 

C*:***  SCHEDULES  —  HASPAR.  ARRIVAL  BACK  AT  ASP. 

C****  SCHEDULED  BY-  DEMAND 

C 

Cm*  CHANGES  NUMBER  OF  HELOS  IN  USE  TQ  SUPPORT  THIS  UNIT. 

C  AMMO  AT  UNIT, 

C 

C  LOCAL  VARIABLE  DEFINITION 

C  MIX  -  AMMO  MIX  INDEX  TO  COMMON  IMIX- 

C  IND  -  INDEX  OF  CURRENT  AMMO  SUPPLIES  IN  IUNIT 

C  IN  -  INDEX  OF  TYPE  AMMO  IN  IUNIT 
C  IAMTYP  -  UNIT  IN  THE  AMMO  TYPE 

C  TVLTIM  -  TRAVEL  TIME 

C  TFAIL  -  TIME  LOST  DUE  TO  MAINTENANCE  FAILURE 

C  TMIND  -  TIME  LOST  DUE  TO  INTERDICTION 

C  TOTIM  -  TIME  OF  SCHEDULED  EVENT 

C 

INCLUDE  LOG. LIST 
DIMENSION  IPARM<5> 

C 

NUNIT  »  IPARM(l) 

NHELI  *  IPARM<2) 

C 

C  FIND  THE  MIX  INDEX  CARRIED  3Y  HFLICOPTER 
MIX  *  ITRUCK(NHELI .5) 

IF (MIX  . LE.  0 .RETURN 

C  INCREMENT  THE  AMMO  ON  HAND  AT  THE  UNIT 
DO  5  I  *  l.LPPAR(S) 

IND  *  13  *  I  -  5 
IN  =  IND  +  4 

C  FIND  UNIT  I  TH  AMMO  TYPE 

IAMTYP  *  IUNIT ( NUNIT .IND ) 

IUNIT ( NUNIT . IN )  =  IUNIT (NUNIT  > IN)  +  IMIX(MIX  .IAMTYP) 
IUNIT ( NUNIT . IN-1 )  =  IUNIT(NUNIT . IN-1 )  -  IMIX ( MIX . IAMTYP > 
5  CONTINUE 

C  FIND  TRAVEL  TIME  BACK  TO  ASP 

TVLTIM  »  60.  *  IUNIT (NUNIT .5)  /  ITYPE( 6. IDAY+1 ) 

C  FIND  THE  DELAY  ASSOCIATED  UITH  MECHANICAL  FAILURE 
CALL  OPERA(NHELI. TVLTIM. TFAIL) 

C*m  DECREMENT  NUMBER  OF  HELO  SERVING  THIS  UNIT 
IUNIT (NUNIT .138)  *  IUNIT(NUNIT. 138)  -  1 
Cm*  ADD  NO.  OF  HELO  THAT  HAVE  SERVED  UNIT 


C  SCHEDULE  HELARV  AT  ASF 

IPARM( 1 i  *  IUNIT (NUNIT >3) 

TOTIM  =  TIME  +  TVLTIM  +  TRAIL 

CALL  SCHED<15> IPARM.TOTIM)  8  HASPA 

C  UPDATE  I  TRUCK  STATUS 

ITRUCK ( NHELI i 3 )  =  4 

ITRUCKCNHELI »6)  =0  8  LOAD 

C 

RETURN 

END 
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SUBROUTINE  INIT 
SUBROUTINE  INIT 
CM***  INITIALIZES  SIMULATION 

CALLED  FROM  MAINARM  AT  START  OF  THE  Cl. 

CALLS  RBJIFF  TO  INITIALIZE  DEMAND  FOR  THE  WHOLE  Cl. 

ALSO:  9IMIT »  SEVENT.  SCHED.  TRKTIM.  CONTRL 

schedules:  endsim 

C»***  H.  JONES  JAN  79 

CHARACTER*3  IANSU 
CHARACTERS  AUNIT 
INCLUDE  LOG 
INCLUDE  GUENUM.LIST 
INCLUDE  QUEPNT .LIST 
INCLUDE  AUNIT. LIST 
INCLUDE  EVENTS. LIST 
DIMENSION  I FARM < 5 ) 

C 

Ctttt  READ  FILES  WITH  ALL  COMMON  DATA 

READ<3)  I ATP . I ASF' » I UN IT > ITRUCK. ITYPE. IMIX.INTER.IRSTME. 

Z  IATF'SD.  IDAY » TIME. IATPAM . ICSA.LPPAR. IASPAM.LUOUT .TCIST. 

Z  TCILNG.  LOOK.  IHEAD.  ITEMS.  AUNIT.  JUNIT.  JATP.  JASP. 

Z  IATPSP. IASPSP. IAMLVL . ISERV 
C 

READ( 7) JSTAT » JEVDS . IEVS 
C 

IF(TIME  .IT.  10 .0) CALL  GINIT 

21  FORMAT (A3) 

PRINT*, 'DO  YOU  WISH  TO  ADD  EVENTS?' 

READ<5.21 )IANSW 

IF(  IANSVI  .EQ.  'YES'  .OR.  IANSW  .EQ.  'Y  ' )  THEN 

CALL  SEVENT  9  READ  ADDTNL  EVENTS  FILE! BUILT  BY  ADDFVT) 

END  IF 
C 

WRITE(6.22) 

22  FORMAT ( '  ENTER  TIME  TO  STOP  SIMULATION  ') 

READ<5»*)  TSTOP 

IPARM(l)  =  9999 
IPARMI2)  *  9999 
IPARM (3)  =  9999 
IPARMI4)  =  9999 

CALL  SCHED  (19,  IPARM.  TSTOP)  9  ENDSIM 

C 

IF (TIME  .LE.  10. )CALL  TRKTIM 
CALL  CONTRL  (TIME) 

TIME  *  TCIST 
C 

C*:<**  READ  FILE  FOR  DEMANDS 
CALL  RDJIFF 
RETURN 


SUBROUTINE  INTROK 
SUBROUTINE  INTRDK ( NUMTK » TLOST ) 

C 

C  DETERMINES  IF  A  TRUCK  ABOUT  TO  TRAVEL  A  ROUTE 
C  MILL  BE  INTERDICTED  ALONG  THAT  ROUTE  AND  ASSESSES 
C  TIME  DELAY  FOR  A  REPLACEMENT  TRUCK. 

C 

C  REPLACEMENT  TRUCKS  SHOULD  BE  SCHEDULED  INTO  THE  ASP 

C  AFTER  A  DELAY  TIME  OF  ' TLOST '  MINUTES. 

C  TWO  DEPTH  ZONES  ARE  CONSIDERED. 

C 

C  CALLED  BY  ASP>  ASPAR1,  ASPAR2>  ATP»  ATPAR1 »  ATPAR2.  AiPARV. 

C  C3ADEP t  DUALMX.  RELOAD*  UNTDEP 

C  CALLS  NOTHING 
C 

C**:t*  J.  FOX  JAN  79 
C 

Ctttt  ZONE  1  ALL  UNIT  TRUCKS  SAVE  THOSE  DIVERTED  FROM  ATP  TO  ASP 
Ctttt  ALL  OTHER  REPLENISHMENT  TRUCKS. 

C 

C  NUMTK  —  THE  NUMBER  OF  THF  TRUCK  BEING  CONSIDERED. 

C  TLOST  —  0  IF  TRUCK  IS  NOT  KILLED 

C  —  REPLACEMENT  TIME  IF  THE  TRUCK  IS  KILLED. 

C  MODCK  —  USED  TO  FIGURE  MODULAR  ARTTH 
C 

Ctttt  SETS  LOAD  OF  REPLACEMENT  TRUCK  TO  100  PER  CENT 
INCLUDE  LOGfLIST 

TLOST  *  0.  0  ASSUME  TK  MADE  IT 

C*«»*  DETERMINE  IF  THE  TRUCK  IS  IN  ZONE  2.  MISSION  >  1 
IF ( I TRUCK (NUMTK  *2)  .GT.  1 >G0  TO  15 
Ctttt  TRUCK  IS  TRAVELING  THROUGH  ZONE  1 
Ctttt  INCREMENT  COUNTER  OF  TRUCKS  IN  ZONE  1 
INTER<9)  =  INTER<  9)  +  1 

Ctttt  IF  SUFFICIENT  NUMBER  OF  KILLS  THIS  Cl  RETURN 
IF< INTER! 1 >  .GE.  INTER<3) ) RETURN 
C 

Ctttt  IF  NOT  EQUAL  0  MODULO  INTER ( 7 )  DO  NOT  KILL »G0  TO  RETURN 
MODCK  =<INTER<9>  /  INTER ( 7 ) >  *  INTER ( 7 ) 

IF(MODCK  .NE.  INT£R(9) )RETURN 
C***«  CHECK  IF  UNIT  HAS  HAD  A  TRUCK  INTERDICTED  THIS  Cl 
L  *  ITRUCK(NUMTK*4) 

C  ONLY  ONE  TRUCK  INTRDKED  PFR  C 

IF( IUNIT (L» 6)  .GE.  TCIST)  RETURN 
INTER ( 1 )  =  INTER ( 1 )  +  1 
TLOST  =  INTER(5> 

C 

C  IF  TRUCK  WAS  ON  RESUPPLY  RUN*  SUBTRACT  AMMO  DUE  IN 

IF ( I TRUCK < NUMTK *3 )  .GE.  4  .AND.  ITRUCK(NUMTK*3>  .LE.  6 S THEN 
L  =  ITRUCK(NUMTK*4) 

MIX  =  ITRUCK(NUMTK*5) 

DO  10  I  *  1 iLPPAR( A) 

K  =  I  *  13  -  5 

IF ( IUNIT (L»K)  ,EQ.  0>G0  TO  10 
IUNIT (L*K+12)  =  IUNIT (L»K+12>  - 


IMIX(MIX*IUNIT(L*K) > 


END  IF 

IF<ITRUCK(NUMTK»5>  .EQ.  10 ) I  TRUCK ( NUMTK > 3 )  =  10  +  LF  PAR ( 7  5 
ITRUCK(NUMTK»3)  =  7 

ITRUCK(NUMTK»9)  =  ITRliCK < NUHTK » 9 )  +  1  9  TRUCK  INTRDK  COUNT 

IF(ITRUCK<NUMTK> 1 )  .EQ.  1  ) THEN 
ITRUCKtNUMTK  1 1 )  =  3 
MIX  =  ITRUCK(NUMTK»5)  +  30 
ITRUCK(NUMTK*5>  *  MIX 
END  IF 

IUNIT  <L»6)  =  TIME 
WRITE<LUQUT»30)  NUMTK.INTER<5) 

30  FORMAT ( '  HAVE  KILLED  ZONE  1  TRUCK  ' »I5»'  TIME  LOST  =  ',16) 

RETURN 


C*m  ZONE  2  TRUCK.  INCREMENT  NUMBER  OF  ZONE  2  TRIPS. 

15  INTER(IO)  *  INTER ( 10 )  +  1 

C*m  IF  SUFFICIENT  ZONE  TWO  TRUCKS  ALREADY  KILLED  GO  TO  RETURN 
IF ( INTER(2)  .GE.  INTER*  4) )RETURN 
Cm*  IF  NOT  ZERO  HNDE  INTER(S) ,  DO  NOT  KILL 

MODCK  *  (INTER(IO)  /  INTER<8>>  *  INTER(8> 

IF (MODCK  .NE.  INTER* 10) )RETURN 
C 

C**t*  HAVE  KILLED  THIS  TRUCK.  INCREMENT  NUMBER  KILLED 
I TRUCK ( NUMTK  >  3 ) =7 

ITRUCMNUMTK.9)  *  ITRUCK*NUMTK.9>  +  1  0  TRUCK  INTRDK  COUNTER 

INTER42)  *  INTER<2)  +1 

C*m  SET  TIME  LOST.  ASSUME  MOT  A  UNIT  TRUCK. 

TLOST  *  INTER<6> 

URITE(LU0UTf20)  NUMTKfTLOST 

20  FORMAT ( '  HAVE  KILLED  ZONE  2  TRUCK'»I5»'  TIME  LOST  *  ',F6,1) 

C 


RETURN 


SUBROUTINE  IQ 
FUNCTION  Id (I TYPE,  NUH i 

C****  RETURNS  QUEUE  NUMBER  ASSOCIATED  WITH  NUM. 

C  CALLED  BY  ASP,  ASPAR1,  ASF  AR'2»  AS  PAR  V  ,  ATP,  ATPARl,  ATPAR 
C  ATPARV  ,  DUALMX »  LDF'WDR ,  RELOAD,  .SERVER ,  UNTARy 

C**«*  JIM  FOX  JAN  7? 

IF ( ITYF'E  .LT.  0  .OR.  ITYPE  .GT.  12)  THEN 

PRINT*,'  BAD  QUEUE  NUMBER  IN  FUNCTION  IQ' 

STOP  '  IQ  ' 

END  IF 

GO  TO  (10, 20>30,40, 50*60, 70, 80, 90, 100. 110, 120),  ITYPE 
C*#X*  UNIT  QUEUE 
10  IQ  =  NUM 
GO  TO  200 
C 

C**:«*  ATP  QUEUE  FOR  CSA-ATP  S  1  P'S 
20  IQ  =  75  F  NUM 
GO  TO  200 
C 

C**x*  ATP  QUEUE  FOR  ASP-ATP  S  &  P'S 
30  IQ  =  85  F  NUM 
GO  TO  200 
C 

C***»  ARTILLERY  SERVER  QUEUE  AT  THF  ATP 
40  IQ  =  95  F  NUM 
50  TO  200 
C 

C***%  MANEUVER  SERVER  QUEUE  AT  THE  ATP 
50  IQ  *  105  F  NUM 
GO  TO  200 
C 

C**X*  QUEUE  TO  HOLD  SERVERS  AT  ATP 
60  IQ  =  115  F  NUM 
GO  TO  200 
C 

C**X*  ASP  QUEUE  FOR  CSA-ASP  S  i  P'S 
70  IQ  =  125  F  NUM 
GO  TO  200 
C 

C**»*  ROUTINE  SERVER  QUEUE  AT  THE  ASF- 
30  IQ  =  135  F  NUM 
GO  TO  200 
C 

c****  MLRS  SERVER  QUEUE  AT  THE  ASF- 
90  IQ  =  145  F  NUM 
GO  TO  200 
C 

C ****  SERVER  QUEUE  AT  ASF- 

100  IQ  =  155  F  NUM 
GO  TO  200 
C 

C***X  S  1  P  QUEUE  AT  CSA 
110  IQ  *  lo5  F  NUM 
GO  TO  200 


SUBROUTINE  LDPWDR 

SUBROUTINE  LDPWDR ( NRNDS * IPARM * ITYP ) 

Cm*  UNLOADS  POWDER  TRUCK  WHEN  ARTY  AMMO  TAKEN  FRON  ATP 
r 

C  CALLED  BY  ATP 

C  CALLS  IQ  *  FINTK *  PUTQUE 

C 

Cm*  J.  FOX  JAN  79 
C 

C*m  IPARM  IS  IDENTICAL  TO  ATP 
C*m  NOTHING  IS  RETURNED 
C 

Cm*  IPARM ( 2 )  —  ATP  NUMBER 

C 

C*X**  LOCAL  VARIABLE  DEFINITION 

Cm*  MIX  -  NUMBER  OF  AMMO  MIX  ON  TRUCK  FOR  COMMON  IMIX 

C****  NRNTK  -  NUMBER  OF  POWDER  CHARGES  ON  THE  TRUCK 

C****  NR  -  AMMO  TYPE  FOR  POWDER 

C****  NPCND  -  NUMBER  OF  CANISTERS  STILL  NEEDED 

C****  NQUE  -  ASP-ATP  QUEUE  NUMBER 

C****  NPDRSP  -  POWDER  AMMO  TRUCK 

C****  NRNDS  IS  NUMBER  OF  POWDFR  CANISTERS  NEEDED 

Cm*  NRNTK  -  NUMBER  OF  CANISTERS  ON  TRUCK 

Cm*  NFZSP  -  TRUCK  NUMBER  OF  FUZE  SSP 

Cm*  NFZQ  -  QUEUE  WGERE  FUZE  TRUCKS  ARE  FOUND 

Cm*  ITYP  -  AMMO  TYPE 

C 

INCLUDE  LOG.LIST 
DIMENSION  IPARM(5) 

C 

NATP  =  IPARM ( 2 ) 

C 

C*X**  SET  AMMO  TYPE  AND  NUMBER  OF  ROUNDS  NEEDED 
C  **HARDUIRE  FOR  ARTY  TYPE 
NR  »  3 

IF ( ITYP  .GT.  5)NR  =  S 
NPCND  *  NRNDS 

C****  FIND  S  J  P.  SAVE  QUEUE  WE  ARE  WORKING  IN 
5  NQUE  =  IQ( IATPSD(2) *NATP) 

CALL  FINTK(NQUE*NR  * NPDRSP  >0) 

C****  IF  HAVE  TRUCK  GO  TO  10.  ELSE  CHECK  CSA  QUEUE 
IF(NPDRSP  .GT.  0 )GQ  TO  10 

r 

W 

NQUE  =  IQ< IATPSD(3) *NATP) 

CALL  FINTK(NQUE*NR*NPDR3P*0) 

C**»*  IF  HAVE  S  S  P  GO  TO  10*  ELSE  WRITE  ERROR 
IF ( NPDRSP  .GT.  0 > GO  TO  10 
WRITE(6*15)NR*NATP 

IS  FORMAT ( '  NO  POWDER  OF  TYPE ' *  14* '  AT  ATP  12  ) 
WRITE(LUOUT  *  15) NR* NATP 
RETURN 
C 

C****  HAVE  S  i  P.  IF  INSUFFICIENT  AMM0*50  TO  20 
10  MIX  *  I TRUCK ( NPDRSP  *  5 ) 


IF (NRNTK  .  LT .  NPCND ) THEN 
C**«*  INSUFFICIENT  AMMO 

I  TRUCK ( NPDRSP » 6 )  =  0 
CALL  PUTQUE ( NPDRSP • NQUE ) 

C  DECREMENT  ROUNDS  NEEDED 

NPCND  =  NPCND  -  NRNTK 
C  GO  GET  ANOTHER  TRUCK 

GO  TO  5 
END  IF 

C ****  SUFFICIENT  AMMO*  OFFLOAD  AND  PUT  BACK  IN  QUEUE 

ITRUCK ( NPDRSP  *  6 )  =  (NRNTK  -  NPCND)  *  lOOOO  /  IMIX ( MIX  *  NR ) 
CALL  PUTQUE  (NPDRSP*  NQUE) 

C****  DECREMENT  AMMO  ON  HAND  AND  DEMAND  IN  SUBROUTINE  ATP 
C****  DECREMENT  FUZES  FROM  S  i  P 
NFZQ  =  IQ(2»NATP) 

CALL  F INTK ( NFZQ  *  20  *  NFZSP  *  0 ) 

IF( NFZSP  .EQ.  0 ) THEN 
'iRI  TE(  6*  20  0  )N  A  TP*  TIME 

200  FORMAT (  NO  S  S  P  UITH  FUZES*  ATP  #'*I2*'*  TIME'*FS.2) 
URITE (LUOUT *200 >NATP, TIME 
RETURN 
END  IF 

NPRCNT  =  NRNDS  *  10000/9000. 

ITRUCK(NFZSP*6)  =  ITRUCK(NFZSP*6)  -  NPRCNT 
I F ( ITRUCK(NFZSP* A)  .LE.  0) ITRUCK(NFZSP*6>  =  0 
CALL  PUTQUE (NFZSP* NFZQ) 


RETURN 


u  u  u  u  rJ  a  o  o 
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SUBROUTINE  LOQKEV 

SUBROUTINE  LOQKEV  ( KIND  *  I  FARM »  EVTIME »  I  GST ) 

LOOKEV  WRITES  EVENTS  ON  THE  AUDIT  TRAIL. 

DISPLAY  OF  AN  EVENT  TYPE  MAY  BE  STRESSED  BY  SETTING 
LOON (EVENT  TYPE)  =  0 

IF  IGET  =  0  THIS  MEANS  THE  EVENT  IS  BEING  SCHEDULED  NOW 

IF  IGET  =  1  THE  EVENT  WILL  BE  EXECUTED  NOW 

CALLED  BY  MAINARM 
CALLS  NOTHING 


C**XX  H.  JONES 


MAR  79 


DIMENSION  IPARM<5) 
CHARACTER*!*)  NAME(19).N 


INCLUDE  LOG. LIST 

DATA  NAME  /'DEMAND'.  'RELOAD'. 

*  'ATP  ',  'ASP  '.  'UNTARV ' . 
i  '  ASF'ARl ' »  '  ASPAR2' .  'HELARV'. 
$  'CONTRL'.  'ENDSIM'/ 


UNTBE? 


ATF'ARV '  ,  '  A3PARV  ' 


' CSAARV ' .  ' ATPAR1 ' »  ' ATPAR2 ' 


'  ASF'ARl ' .  'ASPAR2'.  'HELARV'.  'HASPAR',  'CSADEP'.  'REPORT' 
'CONTRL'.  'ENDSIM'/ 


IF(LOOK(NIND)  .EQ.  0)  RETURN 

IF( (KIND.EQ. 10. OR.MND.EQ.il >. AND. IPARM( 2 >.EQ.O)  RETURN 
N  =  NAME(KIND) 

IF( IGET  .EQ.  1)  WRITE(LUOUT.IO)  N.  IF'ARM,  EVTIME 
10  FORMAT ( 1X.A10? ' .  PARMS  *  TIME*  '.F8.1) 

IF ( IGET  .EQ.  0)  URITE(LUOUT .30)  N.  IF'ARM.  EVTIME 
30  FORMAT < 1X.A10. ' »  PARMS  *  '.516.'.  SCHFD  TIME*  '.F8.1) 

IF (KIND  .EG.  14  .AND.  IGET  .EG.  1 )WRITE( 13»40)N, IPARM. EVTTME 
40  FORMAT ( 35X . A10 » ' .  PARMS  =  '.516.'.  TIME*  '.F3.1) 


RETURN 
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SUBROUTINE  NEXTEV 

SUBROUTINE  NEXTEV  <ITYPE>  IPARM,  EVTIME ) 

C****  INTERFACE  ROUTINE  TO  GET  NEXT  EVENT 
C  CALLED  FROM  MAINARM 

C  CALLS  GETEVT 

£t%$*  H.  JONES  DEC  73 
C 

DIMENSION  IPARM<5> 

CALL  GETEVT  (IPARM,  ITH,  ITS) 

C  ITH  —  EVENT  TIME  IN  WHOLE  MINUTES 

C  ITS  —  EVENT  TIME  (FRACTIONAL)  *  3600 

EVTIME  =  ITH  +  ITS  /  3600. 


U 


ITYPE  =  IPARM<5) 
RETURN 


o  o  o 


ff.  SUBROUTINE  NXTQUE 

SUBROUTINE  NXTQUE  ( ITEM,NUMQUE> 

CXXX*  SHOWS  NEXT  ITEH  IN  VEHICLE  QUEUE (LEAVES  IT  IN) 

CALLED ( IN  EDIT  PROGRAM)  BY  PRINT,  TRKPUT 

CXXXX  H. JONES  FEB  79 

INCLUDE  QUENUH,LIST 
INCLUDE  QUEPNT »LI3T 
ITEM  =  0 
LITEM  =  0 

IPOINT  =  IHEAD(NUMQUE) 

C 

C  SEARCH  DOWN  QUEUE  TO  FRONT 

10  IF ( IPOINT  .EQ.  0)  GO  TO  20 
LITEM  =  ITEM 
ITEM  =  IPOINT 
IPOINT  =  ITEMS(ITFM) 

GO  TO  10 
C 

20  RETURN 
END 
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SUBROUTINE  OPERA 

SUBROUTINE  OPERA  ( NUMTK *  TVLTIM*  DELAY) 

CM***  CALCULATES  DELAY  DUE  TO  RELIABILITY  FAILURE 
C  OPERA  RE— INITIALIZES  THE  TINE  TO  NEXT  FAIL  ( ITRUCK ( rJ* 7 )) 
C  TO  A  NUMBER  EXPONENTALY  DISTRIBUTED  ABOUT  THE  MEAN  TIME 


TO  FA IL( ITYPE i TYPE  *5 ) )  IF  THE  TRUCK  FAILS, 


C  IF  THE  TRUCK  DOES  NOT  FAIL*  THE  RUN  TIME  FOR  THIS  TRIP 
C  IS  DECREMENTED  FROM  THE  TIME  TQ  NEXT  FAIL( ITRUCK(N«7) > . 

C  EACH  TRUCK  HAS  CLOCK  OF  TIME  SINCE  LAST  FAILURE. 

C 

C  CALLED  BY  ASP*  ASPAR1*  ASPAR2  *  ASPCK*  ATP,  ATPAR1  *  A'i  PAR2  * 
C  CSADEP *  DEMAND*  HELARV*  RELOAD*  SERVER*  UNTOEP 

C 


ATP 


Cm*  H.  JONES  JAN  79 

C 

C****  LOCAL  VARIABLES 

C  DELAY  -  TIME  LOST  DUE  TO  REMEDIAL  MAINTENANCE 

C  MTBF  -  MEAN  TIME  BETWEEN  FAILURES  FROM  ITYPE 

C  TLEFT  -  TIME  LEFT  UNTIL  NEXT  FAILURE  AFTER  THIS  MOVE 
C  TVLTIH  -  TIME  LENGH  OF  THIS  MOVE 
C 

INCLUDE  LOG 
DELAY  =  0. 

C 

C*m  COMPARE  TRUCKS  REMAINING  TIME  BEFORE  FAILURE  WITH  TRANSIT  TIME 
ITKTYP  =  ITRUCK ( NUMTK  *  1) 

TLEFT  *  ITRUCK(NUMTK,7)  -  TVLTIM 
IFfTLEFT  .GT.  0.)  THEN 
ITRUCK( NUMTK, 7 )  *  TLEFT 
RETURN 
END  IF 
C 

cm*  FAILURE  OCCURS  THIS  TRANSIT 
C  TIME  TO  REPAIR  IS  LOG  NORMALLY  DISTRIBUTED 
XMTTR  =  ITYPS( ITKTYP*  6) 

XMU  =  .5  *  ALOG< (XMTTR  *  XMTTR)  /  2.) 

SIGMA  =  SORT(ALOG( (XMTTR  *  XMTTR)  /  (XMTTR  *  XMTTR)  r  1.)) 

U1  =  RANF(DUM) 

U2  *  RANF(DUM) 

XI  =  ((-2  *  ALOG(Ul))  **  .5)  *  C0S(2  *  3.14159  *  U2> 

DELAY  =  EXP (SIGMA  *  XI  +  XMU) 

IF ( DELAY  ,LT .  60 . ) DELAY  =  60. 

IF ( ITRUCK (NUMTK *3)  .EG.  0 ) DELAY  =  60.  8  RELOAD  FAILURE 
cm*  COMPUTE  TIME  TO  NEXT  FAILURE ( EXPONENTIAL  DISTRIBUTION) 

XMTBF  s  ITYPE( ITKTYP, 5) 

UNRN  =  RANF(DUM) 

ITRUCK(NUMTK*7)  »  ( -XMTBF*ALOG( 1-UNRN ) ) 

C 

C*m  WRITE  MESG  FOR  LOST  TRUCK 

URITE(LH0UT*5)  NUMTK* TIME* INT( DELAY) 

3  FORMAT ( '  TRUCK  NUMBER'*I5*'  FAILED  AT  '*F3.l*'  FOR'.TS*'  MINijT 
"RUCK  (  NUMTK  *  3  )  =  6 
l TRUCK ( NUMTK  *  8 )  *  ITRUCK ( NUMTK *  3 )  t  1 


3  FAILURE  COUNTER 


hh.  SUBROUTINE  PUTEVT 

SUBROUTINE  ?UTEVT(IEVT,  ITK»  ITS.  ICHECK) 

C 

C  PUTEVT  PLACES  AN  EVENT  RECORD  IN  THE  QUEUE  IN  CHRONOI  03ICAL 
C  ORDER  AND  UPDATES  THE  QUEUE  DIRECTORY.  ICHECK  FLAG  SET 
C  IF  INSERT  WAS  UNSUCCESSFUL. 

C 

C  A  LINEAR  SEARCH  IS  DONE.  EITHER  FROM  THE  BACK  FORWARD 
C  OR  FROM  THE  FRONT  BACKWARD(WHICH  EVFR  IS  CLOSER  TO  THE 
C  EVENT  TINE).  TO  INSERT  THE  EVENT. 

C 

C  BOB  DAVISON  1978 

C 

INCLUDE  EVENTS. LIST 

DIMENSION  IEVT<5) » JFQRE(2048) » JBACK(2043) » JTIME(2048»2) 
EQUIVALENCE  ( JFOREf 1 ) . JEVDSd . 1 ) ) . < JBACKI 1 ) . JEVDSI 1 .2 ) ) . 

Z  ( JTIME ( l » 1 ) , JEVOS ( 1 , 3 ) ) » ( JSTAT ( 1 ) . JF IRST ) . ( JST AT ( 2 ) . JLAST ) 
Z  (JSTAT (3) , JEMPTY) ,( JSTAT' 4) .NUMEVT) . <  JSTAT ( 5 ) .NEMFTY) . 

Z  (JSTAT (6) .MAXEVT) 

C  CHECK  IF  SPACE  AVAILABLE  ..  IF  NONE.  RETURN 
ICHECK  =  2049  -  NEMF'TY 

IF(NEMPTY.LE.O)  GOTO  400  8  RETURN 

ICHECK=0 

LSAVE=JFORE( JEMPTY ) 

C  PUT  EVENT  RECORD  IEVT  IN  IEVS 
DO  20  IN  =  1.5 

IEVS( IN. JEMPTY)  *  IEVT(IN) 

20  CONTINUE 

C  IF  NO  EVENTS  IN  QUEUE.  PERFORM  THE  FOI  LOWING 
IF ( NUMEVT .GE. 1 )  GOTO  200 
JFORE( JEMPTY)=0 
JBACK ( JEMPTY  >  =0 
JFIRST*JEMPTY 
JLAST*JEMPTY 
GOTO  380 

C  IF  ONE  EVENT  IN  QUEUE.  PERFORM  THE  FOLLOWING 
200  CONTINUE 

ITFH= JTIME (JFIRST.l) 

ITFSaJTIME(JFIRST,2) 

IF (NUMEVT • GT . 1 )  GOTO  300 
C  IF  LOWEST  TIME  EVENT,  PERFORM  THE  FOLLOWING 
IF ( ITH.GT . ITFH) GO  TO  210 
IF( ITH.EQ . ITFH. AND . ITS . GE . ITFS )G0  TO  210 
JFORE<  JEMPTY) a JFIRST 
J8ACM  JEMPTY)=0 
JBACK ( JFIRST ) = JEMPTY 
JLAST  =  JFIRST 
JFIRSTaJEMPTY 
GOTO  380 
C 

C  ELSE  THIS  TIME  IS  EQUAL  TO  OR  LATER  THAN  THE  LAST  EVFNT 
210  CONTINUE 

JFQRE( JEMPTY)aO 
JBACK ( JEMPTY )= JFIRST 
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JLAST= JEMPTY 
GOTO  380 

C 

C  IF  TWO  OR  MORE  EVENTS  IN  QUEUE*  PERFORM  THE  FOLLOWING 
300  CONTINUE 

C  IF  EVENT  TIME  IS  LESS  THAN  FIRST  EVENT,  HAKE  IEVT  THE  FIRST  EVENT 
IFi ITH.GT . ITFHiGO  TO  310 
IF(ITH.EQ.ITFH.AND.ITS.GE.ITFS)GO  TO  310 
JFQRE( JEMPTY  >  =JFIRST 
JBACK( JEMPTY )=0 
JBACK(JFIRST)=JFMPTY 
JFIRSTsJEMPTY 
GOTO  330 

C 

C  IF  EVENT  TIME  IS  GREATER  THAN  OR  EQUAL  TO  LAST  EVENT,  MAKE  IEVT  LAST 

310  CONTINUE 

ITLH=JTIME< JLAST ,1 ) 

ITLS=JTIME(JLA3T,2) 

IFdTH.LT, I TLH ) GO  TO  320 

IF( ITH ,EQ . ITLH.AND.ITS.LT . ITLS5G0  TO  320 

JFORE( JEMPTY)=0 

JBACKI JEMPTY) -JLAST 

JFOREv  JLAST ) = JEMPTY 

JLAST= JEMPTY 

GOTO  380 

C 

C  EVENT  TIME  IS  BETWEEN  JTIME( JFIRST)  AND  JTIME( JLAST) 

320  CONTINUE 

NUM=NUMEVT-1 

C  IF  EVENT  TIME  CLOSER  TO  FIRST,  START  SEARCH  AT  FIRST  EVENT 
IF( (ITH-ITFH)-< ITLH-ITH) >326,325,350 

325  IF ((ITS-ITFS)-(ITLS-ITS) >326,326, 350 

326  IND1= JFIRST 
IT1H=ITFH 
IT1S=ITFS 
IND2=JF0RE( JFIRST) 

IT2H=JTIME(IND2,1) 

IT2S=JTIME(IND2,2) 

DO  330  1=1, NUM 

IF < ITH.GT « IT2H)G0  TO  327 
IF(ITH.EQ.IT?H,AND.ITS.GE.IT2S)G0  TO  327 
GO  TO  340 

327  IND1=IND2 
IT1H=IT2H 
IT1S=IT2S 
IND2=JF0RE ( IND2 ) 

IT2H=JTIME(IND2, 1 ) 

IT2S=JTIME( IND2,2) 

330  CONTINUE 
ICHECK=2 

GOTO  400  8  RETURN 

340  JF0RE(IND1)=JEMPTY 
JBACK ( JEMPTY ) =IND1 
JFORE( JEMPTY ) =IND2 


r 


GOTO  380 


C  EVENT  TINE  CLOSER  TO  LAST.  START  SEARCH  AT  LAST  EVENT 
350  INB1=JLAST 
IT1H=ITLH 
IT1S=ITLS 
IND2= JBACK ( JLAST ) 

IT2H=JTIME( INB2. 1 ) 

IT2S=JTIME(IND2»2) 

DO  360  1=1. NUM 

IF ( ITH.LT . IT2H)G0  TO  355 
IF(ITH.EQ.IT2H.AND.ITS.LT.IT2S)G0  TO  355 
GO  TO  370 
355  IND1=IND2 

IT1H=IT2H 
IT1S=IT2S 
IND2=JBACK ( IND2 ) 

IT2H=JTINE( IND2. 1 ) 

IT2S=JTINE( IND2.2) 

360  CONTINUE 
ICHECK=2 

GOTO  400  3  RETURN 

370  JF0RE(IND2)=JEMPTY 
JBACK ( JEMPT Y ) = IND2 
JFORE<  JENPTY ) =IND1 
JBACK  ( IND1  )=JENF'TY 
C 

C  PERFORM  THE  FOLLOWING  FOR  ALL  EVENTS 
380  CONTINUE 

JTIME ( JENPTY » 1 )  =  ITH 
JT I ME (JENPTY  »2)=ITS 
NUMEVT=NUMEVT+1 
NEMPTY=NENPTY-1 

JEMPTY=LSAVE 
r 

w 

400  RETURN 
END 
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SUBROUTINE  PUTQUE 
SUBROUTINE  PUTQUE  (ITEM.  NUNQUE) 

C#***  PUTS  ITEH  IN  QUEUE  NUMQUE 
C 

C  CALLED  BY  ASPAR1,  ASF'AF:2»  ASF’ARV*  ATPAR1*  ATPAR2*  ATPARV*  C3AASV, 
DEPASP »  FINTK *  LDPWRR *  SERVER*  UNTAR'J 
(IN  EDIT  PROGRAM:  EDIT*  PRINT*  TfiKPUT) 

C****  ri.  JONES  DEC  73 
INCLUDE  LOGfLIST 
INCLUDE  QUENUN.LIST 
INCLUDE  QUEPNT tLIST 
IF(NUMGUE.LT.1.0R.NUMQUE.GT.176)THEN 

PRINT*,'  BAD  QUEUE*  IN  PUTQUE ...  ITEM  NUT  PUT  IN  QUrUE' 

RETURN 
END  IF 
C 

C  **  LOOP  FOR  ALL  QUEUES 
DO  40  I  =  1,17a 

IPOINT  =  IHEAD(I) 

C  **  LOOP  FOR  ALL  ITEMS  IN  QUEUE 
20  CONTINUE 

IF ( IPOINT  .EQ.  0)THEN 
C  **  EXIT  LOOP 

GO  TO  30 
END  IF 

IF ( IPOINT  .EQ.  ITEM1THEN 
WRITE<6, 100)1 TEM,I*TI ME 

100  FORMAT < '  TRUCK', 15*'  IS  ALREADY  IN  QUEUE', 14,'  Ai  TIME',F8.1) 

RETURN 
END  IF 

IPOINT  =  ITEMS- IPOINT) 

GO  TO  20  - 

30  CONTINUE 

C  **  END  LOOP 

40  CONTINUE 
C  **  END  LOOP 
C 

IQLDH  =  IHEAD(NUMQUE) 

IHEAD<  NUMQUE)  =  ITEM 
ITEMS( ITEM)  =  IOLDH 
C 

RETURN 


SUBROUTINE  QINIT 
SUBROUTINE  QINIT 

INITIALIZE  THE  EVENT  QUEUE (EMPTY )  AT  THE  START 
OF  FIRST  Cl. 

CALLED  FROM  MAINARM 

BOB  DAVISON 

INCLUDE  EVENTS, LIST 

DIMENSION  JF0REC2Q48) » JBACK (2048) ,  JTIME( 2048, 2 ) 

EQUIVALENCE  ( JFORE < 1 > , JEVDSt 1 » 1 >  > » < JBACK (1) , JEVDS <  1 , 2  >  > » 

Z  ( JTIMEQ » 1 ) » JEVDS < 1 »3>  > » <  JFIRST , JSTAT ( 1 ) > . ( JLA3T  , JST AT <  2 > )  , 
1  (JEMPTY, JSTAT (3) ) » ( NUMEVT » JSTAT (4) ) , (NEMPTY, JSTAT (  !j) ) , 

Z  (MAXEVT, JSTAT(S)) , ( JTIME<1,2>» JEVDS ( 1.4) > 

NUMEVT =0 
NEMPTY  =  2048 
JFIRST=0 
JLAST =0 
JEMPTY =1 

DO  100  1*1,  NEMPTY 
JFORE< I )=I+1 
JBACK  < I ) =1-1 
JTIME ( I , 1 ) =0 
JTIME(I»2)=0 
100  CONTINUE 

JF0RE(NEMPTY)=0 
JBACK  < 1 )=0 
PRINT*,'  QINIT' 


RETURN 


SUBROUTINE  RDIEXO 
SUBROUTINE  RDIEXO(NUNIT) 

UPDATES  IUNIT  EACH  PULSE  OF  A  MULTI-DEMAND  AND  SCHFD  DEMAND 

CALLED  BY  DEMAND 
CALLS  3CHED 

SCHEDULES  DEMAND  (FOR  NEXT  PULSE) 

JIM  FOX  -  FEB  197? 

INCLUDE  LQG.LIST 

LOCAL  VARIABLES 
NUNIT  -  UNIT  NUMBER 

NCELLS  -  NUMBER  OF  DEMAND  PULSES  IN  DEMAND  UN'T  RECORD 
NMDEAD  -  NUMBER  OF  WEAPONS  KILLED 

NDEDRD  -  NUMBER  OF  DEAD  ROUNDS.  LOST  WHEN  WPN  KILLED 
NMRD  -  NUMBER  OF  ROUNDS 

NUMPL  -  NUMBER  OF  THE  PULSE 
NCELLS  -  NUMBER  OF  PULSES  PER  Cl 

DIMENSION  IPARM ( 5 ) 

DO  5  I  =  1.5 
IPARM ( I )  =  0 
5  CONTINUE 

SET  IPARM  TO  CALL  TO  SCHEDULE  DEMAND 
IPARM ( 1 )  =  NUNIT 

FIND  NUMBER  OF  DEMAND  PULSE  CELLS 
NCELLS  =  IUNIT (NUNIT .139) 

IF(NCELLS.LE.l)  GO  TO  10 

COMPUTE  THE  TIME  OF  THE  NEXT  DEMAND  EVENT  AND  SCHEDULE  IT. 
TOTIM  =  TIME  +•  TCILNG  /  NCELLS 
IF ( TOTIM  ,GT.  TCIST  +  TCILNG >G0  TO  10 
CALL  SCHEDU,  IPARM, TOTIM  )  0  DEMAND 

10  CONTINUE 

IF(NCELLS.LE.l)  NCELLS=1 

UPDATE  IUNIT  WITH  A  PART  OF  THE  DEMAND  DATA 

DO  100  I  =  1»LPPAR<6) 

IND  *  I  *  13  -  5 

IF  NO  DATA  TO  UPDATE  GO  TO  100 

IF ( IUNIT (NUNIT » IND+10)  .LE.  0)G0  TO  100 

COMPUTE  WHICH  PULSE  THAT  THIS  UPDATE  REPRESENTS 

NUMPL  *  (TIME  -  TCIST)  /  (TCILNG  /  NCELLS)  +  .3 

IF (NCELLS. LE. 1 )  NUMPL=1 

COMPUTE  NEGATIVE  SURVIVOR  FACTOR 

LOWER  NUMBER  OF  SURVIVORS  FOR  THIS  PULSE 

COMPUTE  THE  NUMBER  OF  DEAD  TO  BE  ASSFSSED  THIS  PULSE  -  NMDEAFi 
NMDEAD  *  ( I  UNIT  ( NUNIT,  IND+9 )  +NUMPL-1 )  /  NCEi.LS 

COMPUTE  NUMBER  OF  RNDS  LOST  WITH  DEAD  WPN 
IF ( IUNIT ( NUNIT ,  1 ) .  EQ.  3 ) THEN 

NDEDRD  *  IUNIT (NUNIT , INO  +  7 ) KNMDEAD 
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END  IF 

C  IF  NEG.  ROUNDS  ON  HAND  -  NONE  LOST. 

IF(IUNIT(NUNIT.IND+4)  .IE.  0)  NDEDRD  =  0 
I  UN  IT ( NUN  IT » TNO+1 )  =  IUNI T ( NUN  IT , IND+ 1 )  -  NrtDEAO 
IF ( IUNIT ( NUNIT  * IND  +  1 ) . LT . 0  /  IUNIT ( NUN IT , IND+1 ) =0 
C*X**  ASSUME  SINGLE  PULSE  UNIT 

IUNIT ( NUNIT  , IND+2  >  =  IUNIT( NUNIT  , IND+10) 

C****  CHECK  FOR  ARTY  UNITS 

IF* IUNIT (NUNIT , D.GE.4.AND. IUNIT (NUNIT, 1) .LE.6J  IUNIT (NUN IT 1 IND+2) 
2  =  IUNIT(NUNIT, IND+1) 

C  IF  FARR.  NUMBER  OF  WEAPONS  SHORT  AMMO  =  NUM  IN  CELL 

IF ( IUNIT ( NUNIT » 1 )  .EQ.  8) IUNIT (NUNIT, IND+2 >  =  IUNIT < NUNIT . IND  +  2 > 

+  (IUNIT(NUNIT, IND+10)  +  NUMPL  -  1)  /  NCELLS 

UPDATE  A  PORTION  OF  ROUNDS  SHORT 
C  COMPUTE  THE  NUMBER  OF  ROUNDS  SHORT  TO  BE  ASSE3SF3  THIS  PULSE-NMRD 
NMRD  =  (IUNIT (NUNIT • IND+1 1 )  +  NUMPL  -  1)  /  NCEi L5 

IUNIT  (  NUNIT,  IND+3  )  =  IUN  IT  (NUN  I T > IND+3 ) +NMRD- ( IUNIT  <  NUNIT,  IND+7) 

Z  4NMDEAD  -  NDEDRD) 

C  COMPUTE  AMMO  ON  HAND 

I  UNIT ( NUNIT , IND+4)  =  IUNIT ( NUNIT , IND+4 )  -  (NDEDRD  +  NMRD) 

100  CONTINUE 
C 

RETURN 
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160  CONTINUE 

I c ( IFF.LE.O) RETURN 

ADDTIN  =  TCIST  *  TCILNG 
RETURN 

END  SUBROUTINE  GNERD 


SUBROUTINE  HELIRD ( IFF , ADDTIN ) 

THIS  SUBROUTINE  UPDATES  I UN IT  ARRAYS  FOR  AO I AT I ON 
UNITS  AND  SETS  FLAG  IFF  TO  SCHEDL".  E  DENAND  EVENT) 
ADDTIN  IS  CALCULATED  TINE  FOR  EVENT  TO  BE  SCHEDULED. 


190  DO  200  II J  =  8,21*13  SLOOP  ON  TWO  ijjNIT  ANNO  TYPES 
NCELLS^O 

NHELCL=0  •*- 

NWPNAL30 

NWPNSH=0 

NRNSH*0 

DO  212  NNI *4 , 30 , 3 

IF( IRDJF(NNI ) ,LE.O)GO  TO  212  SNO  HELICOPTERS  IN  CELL 
IF( IRD JF ( NNI-3 ) . NE . IUNIT( IREC , 1 1 J ) ) GO  TO  212  SNO  ANNO  NATO; 
NCELLS=NCELLS  +1 
NHELCL=NHELCL  *  IRDJF(NNI) 

NWPNAL3NWPNAL  *  IRDJF (NNI-2) 

NWPNSH-NWPNSH  *  IRDJF(NNI-l) 

NRNSH=NRNSH+IRDJF (NNI+1 ) 

2  CONTINUE 

IF  NO  CELLS,  SCHEDULE  NO  DENAND  EVENTS 
IF ( NCELLS . LE . 0 ) THEN 
IFF  30 
RETURN 
END  IF 

compute  time  between  demand  pulses 
ADDTIN=TCILNG/NCELLS 

update  number  of  demands  for  this  far? 

IUNIT( IREC, 139) aNCELLS 
taKe  care  of  the  single  farp 
IF<NCELLS.LE. 1 ) ADDTIN3TCILNG/2. 
update  holding  area  in  unit 
I UNIT ( IREC, I I J*9 ) *NHELCL 
I  UN  I T  ( IREC ,  1 1  J  1 0 )  3  NWPNSH 
IL'NIT(  IREC,  II  J*ll )  3  NRNSH 
IFdU.GT.S  .AND.  IFF.GT.O)GO  TO  200 
err  ci  Atvjn  ttmc  FOR  DCNAND  EVENT 


RETURN 

200  CONTINUE 


SUBROUTINE  ARTYRD ( IFF , ADDTIN  ) 


TLj  t  2  SUBROUTINE  MODIFIES  I  UN  IT  ARRAYS  FOR  ARTILLER': 
UNITS  AND  SETS  FLAG  FOR  DENAND  EVENT , AND  SE”S  ADDT’ 
TO  SHOW  TINE  TO  SCHEDULE  THE  EVENT 
210  ADDTIN  *  TCIST  *  60. 

IFF*  1 

FT ND  ANNO  TYPCS  TO  UPDATE  I UN IT  HOLDING  FOR  ARTY 
IUNIT( IREC, 129)  =  I  NT  ( TCILNG  /  60.  *  .5) 

DO  240  IA  *  1,20,3 

SELECT  ANNO  RECORD  FRON  IRDJF 

IANN  *  IRDJF(IA)  9THIS  IS  ANNO  TYPE  FRON  DENAND  FILE 
IF ( I ANN . E3 . 0 ) GO  TO  240  SNO  ANNO  TYPE  GET  NEXT  ONE 
FIND  CORRESPONDING  UNIT  ANNO 
DO  220  !U  *  1 , LPPAR( 6 ) 

IUA  *  13  *  IU  -  5 

IUAN  *  IUNIT ( IREC , IUA )  9THIS  IS  ANNO  TYPE  FROf 
I F ( I UAM . EG . 0 ) GO  TO  220  9ANN0  TYPE  0  GET  NEXT  ONE 
IF  NOT  THE  SANE  ANNO  GO  TO  220 
IF (IUAN  .NE.  IANN) GO  TO  220 
HAVE  ANNO  NATCH.  SET  UP  FILE  IUNIT. 

I UN IT < IREC, IUA+9) =  IUNIT ( IREC, IUA* 1 )  -  IRDJF (I A*: 
IF ( IUN!T(  IREC  ,  IUA*  1 )  ,LT.  IRD  JF(  I  A*1 )  )  IUNIT <  IREC ,  I1. 
5  IRDJF ( IA+1 ) 

IF ( IUNIT < IREC, JUA*9>  .LT.  0) IUNIT( IREC, IUA+9)  *  ( 
IUNIT( IREC, IUA+10)  *  IRDJF ( I A*2 ) 

IUNIT( IREC, IUA+11 )  *  IRDJF ( !A*3 ) 

GO  TO  240 
220  CONTINUE 

WRITE  ( LUOUT ,230)1 REC , I A 

220  FORNAT( '  NO  IUNIT  ANN  NATCH  -  RDJIFF,  UNIT 
IFF*0 
RETURN 

240  CONTINUE 
RETURN 


IUNIT  ARR 


"NO  ',13' 


END  SUBROUTINE  ARTYRD 


SUBROUTINE  READF 

SUBROUTINE  READF  <LU.  NUN  *  INTGR  >  REAL  .  IwORD* 

C**'**  RETURNS  UP  TO  NUN  INTEGERS »  REALS »  AND  STRINGS. 

Ct***  BLANKS  AND  COMMAS  ARE  DELIMITERS.  READS  FROM  TERMINAL. 
C*m  H.  JONES  1979 
C 

CHARACTER*! *)  IWORD 

CHARACTER* 1  I  BLANK  > IPERD* ICOMMA. IMINUS » IQUQT  ? IALDIG. ICHR 
DIMENSION  INTGR(NUM)  .  REAL ( NUM)  .  IUORD(NIJM) 

DIMENSION  ICHR(82>  >  IALDIG(IO) 

DATA  I BLANK  /'  '/.  IPERD  /'.'/»  ICOMMA  IMINUS  /'- 

DATA  IQIJOT/  ' ' '  •  / 

DATA  IALDIG  /" T > ' 2' » '3' » ' 4' » ' 5 ' . '6 ' » » ' 8' » '? ' , 'O'/ 
ICHR (31 )  =  IBLANK 
ICHR<82)  =  IQUQT 
C 

C****  READ  RECORD »  ZERO  OUT  OLD  INTGR.  REAL.  I'jnRD 
READ(LU.210.END*  190)  (ICHR(I).  1=1.30) 

DO  10  1=1. NUM 
INTGR ( I ) =0 
REAL(I)=0. 

10  IMORD(I)  =  IBLANK 
KW0RD=0 
KINTGR=0 
KREAL=0 
N=0 
C 

C*»**  CHECK  NEXT  CHARACTER  IN  RECORD 
C ****  SKIPPING  BLANKS  ********** 

20  MINUS  =  1 
30  N=N+1 

IF(N.EQ.Sl)  GO  TO  190 
IF(ICHR(N).EQ, IBLANK)  GO  TO  30 
C 

C****  DETERMINE  IF  CHAR  IS  NUMBER  OR  ALPHA 
IF < ICHR ( N )  .EQ.  IQUOT)  GO  TO  160 
IF ( ICHR (N)  .NE.  IMINUS)  GO  TO  40 
MINUS  =  -1 
GO  TO  30 
40  ISTART  =  N 
NUMB=0 

IFvICHR(N) .EQ. IPERD)  GO  TO  90 
DO  50  1=1.10 

IF ( ICHR(N) ,E9. IALDIG< I ) )  GO  TO  60 
50  CONTINUE 
GO  TO  150 


C*:***  BUILDING  INTEGER  OR  INTEGER  PART  OF  RFAL 
60  N=N+1 

IF ( ICHR(N)  .NE.  IBLANK  .AND.  ICHR(N)  , NE .  IPERD 
*  .AND.  ICHR(N)  .NE.  ICOMMA  )  GO  TO  60 
C 

C****  CALCULATE  VALUE  OF  INTEGER 


DO  30  I=ISTART « IEND 
DO  70  J=l»? 

IF(ICHRd)  .£Q.  lALDIG(J))  50  TO  80 
70  CONTINUE 
J=0 

30  NUMB  =  NUMB  +  J  *  10  lENH-I ) 

IF ( ICHR(N)  .EQ.  IPERD)  GO  TO  90 
C 

C ****  NUMBER  WAS  INTEGER.  STORE  IT.  CHECK  FOR  BLANKS 
KINTGR  =  KINTGR  +1 
INTGR ( KINTGR >  =  NUMB  *  MINUS 
GO  TO  20 

Cm*  NUMBER  WAS  INTEGER  PART  OF  REAL.  NOW  BUILD  DECIMAL. 

90  RNUMB  =  FLOAT (NUMB) 

ISTART  *  N+l 

IF( ICHR ( ISTART)  .EQ.  IBLANK )  GO  TO  140 
100  N=N  +  1 

IF<ICHR(N) .NE. IBLANK  .AND.  ICHR(N) .NF. ICOMMA  >  GO  TO  100 
C 

C****  CALCULATE  VALUE  OF  DECIMAL 
IEND  =  N-l 
1DECPL  =  1 
NUMB=0 

DO  130  IaISTART » IEND 
DO  110  J«1.9 

IF(ICHR(I)  .EQ.  IALDIG(J>>  GO  TO  120 
110  CONTINUE 

J*0 

120  NUMB  =  NUMB  +  J  *  10** (IEND- I) 

130  IDECPL  =  IDECPL  *  10 
C 

C****  ADD  INTEGER  AND  DECIMAL 
DECMl*FLQAT( NUMB) /IDECPL 
RNUMB  *  RNUMB  +  DECML 
140  KREAL  =  KREAL  +  1 

REAL(KREAL)  *  RNUMB  *  MINUS 
GO  TO  20 
C 

0***1  BUILDING  STRING  ALPHANUMERIC 
150  N=N  +  1 

IF(ICHR(N).N£. IBLANK  .AND.  ICHR(N) . NE. ICOMMA  )  GO  TO  150 
GO  TO  190 
160  ISTART  =  N+l 
170  N=N+ 1 

IF ( ICHR(N)  .NE.  IQUOT)  GO  TO  170 
180  IEND  *  N-l 

KUORD  *  KWORD  +  1 

LENSTR  *  IEND  -  ISTART  +  1 

IF ( LENSTR  .GT.  10)  LENSTR  =  10 

ENCODE (LENSTR, 200.  IUORD ( KWORD ) )  (ICHR(J),  JdSTART,  IEND 
GO  TO  20 
C 

190  RETURN 
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nn.  SUBROUTINE  RELOAD 

SUBROUTINE  RELOAD  < I FARM ) 

Cm*  EVENT  RELOAD  —  REPLACES  ROUNDS  OF  AMMO  AT  UNIT  WEAPONS. 

C  EVENT  TYPE  2 

C  CALLED  BY  MA INARM 

C  CALLS  IQ*  DUALMX  *  FINTK*  INTRDK  *  SCHED*  OPERA 
C 

C**»*  D.  HILLIS  JAN  79 

C 

C***»  IF'ARM(l)  —  UNIT  NUMBER 

C***»  IPARM( 2 )  —  0  IF  SCHED  FROM  DEMAND*  TRK»  IF  SCHED  FROM  UNTAR V 

p 

C  SCHEDULES  —  UNTDEP.  DEPARTURE  OF  UNIT  TRUCKS 

C  UNTARV*  ARRIVAL  OF  TRUCKS  AT  UNIT. 

C  ASPARV »  EMPTY  TRUCKS  ->  ASF' 

C  SCHEDULED  BY  DEMAND  OR  UNTARV 

C 

C  RELOAD  UILL  OCCUR  AT  THE  TASK  FORCE  LEVEL  FOR  MANEUVER  UNITS  * 

C  BATTERY  LEVEL  FOR  ARTILLERY  UNITS  AND  ADA  IINHS*  AND  AT 

C  BATTALION  FARRP'S.  THE  RELOAD  UILL  BE  CALLED  FROM  THE  DEMAND 
C  EVENT. 

C 

C 

C  AMMO  UILL  BE  CONSOLIDATED  QN  TRUCKS  AT  UNIT.  NO  MGRE  THAN  1  TRUCK 

C  PER  UNIT  (PFR  TYPE  OF  AMMO)  WILL  BE  AT  LESS  THAN  FULL  LOAD  WHILE 

C  LOCATED  AT  THE  UNIT.  A  'SMALL  LOAD'  THRESHOLD  MAY  BF  DEFINED  BFLOU 

C  WHICH  AMMO  IS  DUMPED  TO  GROUND  TO  ALLOU  TRUCK  TO  RETURN  TO  ATP. 

C 

C*m  LOCAL  VARIABLE  DEFINITION 

Cm*  K  -  UNIT  AMMO  INDEX 

C*m  TQTIM  -  TIME  OF  SCHEDULED  EVENT 

Cm*  DELAY  -  TIME  TO  RELOAD  WE  A'  jNS  AT  THE  UNIT 

Cm*  LOAD  -  NUMBER  OF  ROUNDS  ON  THE  TRUCK 

C*m  ND  -  AMMO  DEMAND 

•:****  NUMTK  -  TRUCK  NUMBER 

Cm*  NEWLB  -  TRUCK  LOAD  ON  AMMO  DEMAND 

C m*  MX  -  AMMO  MIX  INDEX 

Cm*  I  AM  -  AMMO  TYPE 

C*m  KIND  -  EVENT  TYPE 

cm*  TMIND  -  DELAY  TIME  DUE  TO  INTERDICTION 
C***«  NRPU  -  NUMBER  OF  ROUNDS  PER  WEAPON 
Cm*  NU  -  NUMBER  OF  WFAPONS  LOADED  PER  TRUCK 
C*m  IPLOAD  -  PARTIAL  LOAD 

Cm*  IFLAG  -  0  -FARP  TRUCK  AVAIL.*  i  -NO  FARP  TRUCK  AVAIL. 

INCLUDE  LOG.LIST 
DIMENSION  IPARM(5) 

C 

NtJNIT  3  IPARM(l) 

IUNITQ  *  IQ(l'NUNIT) 

C**»*  SELECT  AN  AMMO  TYPE 
DO  180  KN3 1  * LF'F'AR ( 6 ) 

K313  *  KK  -  5 

IAM  3  IUNIT (NUNIT *K> 

IF ( I AM  .EQ.O)  GO  TO  180 
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IF ( IUNIT ( NUNIT »K+8  >  .LE.  0)G0  TO  ISO 
C****  IF  THE  UNIT  HAS  MORTARS  AND  BUSHMASTFRS  USE  RELOAD  ROUTINE  DUALM 
C***:K  !!!!  THE  NEXT  LINE  ASSUMES  THAT  MORTARS  AND  BUSH.  GO  TOGETHER 
IF( IAN  .EG.  14)  THEN 

CALL  DUALMX ( NUN  IT » K » K  +  13 ) 

RETURN 
END  IF 
C 

Cm*  CALCULATE  AMMO  DEMAND 

10  NO  =  IUNIT ( NUNIT •  K  +  7 )  *  IUNIT'NUNIT.K+1 )  -  I!JNIT<NUNIT.K+4) 

IF< IUNIT< NUN IT » 1 ) .EQ.3 )  ND  =  IUNI T ( NUNIT » K  +  3 ) 

IF ( IUNIT (NUNIT » 1 )  .EG.  3)  GO  TO  15 

IF(ND.LT.IUNIT( NUNIT r K+4 )  -  IUNIT(NUNIT»KE2)  *  IUNIT(NUNIT»K+5 > 
$  GO  TO  180 
IFCIAM  .EG.  10) THEN 
ND  =  (ND  /  6)  *  4 

IUNIT (NUNIT »K  +  3)  =  lUNIT'NUNIT.K  4  3)  -  ND 
END  IF 

15  IF ( ND  .LE.  0 ) GO  TO  130 
C 

URITE(LU0UT«20)IAM»ND 

20  FORMAT ( '  RELOAD  AMMO  TYPE'. 215*'  ROUNDS') 

C  PULL  TRUCK  FROM  QUEUE 

30  CALL  FINTK(  IIJNITQ,  IAM»NUMTK*0) 

URITEILUOUT  »40)NUMTK 
40  FORMAT ( '  RELOAD  AFTER  FINTK  '»I5> 

IFUUNITINUNIT.l). EQ.3. AND. NUMTK.EQ.O)  GO  TO  180 
IF < IUNIT (NUNIT* 1 ) .£0.3)  GO  TO  90 
IFtNUMTK  .EQ.  0)GO  TO  130 
C**t*  CHECK  FOR  INTERDICTION 
MX=ITRUCK(NUMTK*5> 

NOFF  a  (IMIX(MX.IAM)  *  ITRUCK  <  NUMTK  ?  6  )  +  9999)/ 10000 
CALL  INTRDK ( NUMTK tTMIND ) 

IF(TMIND  .EQ.  0)G0  TO  90 
C 

C:<***  ADD  ONE  TO  THE  NUMBER  OF  TRUCKS  KILLED  DURING  RELOAD 

JUNIT ( IUNIT (NUNIT » 1 ) » 2  3 i  =  JUNTT( IUNITlNUNITt 1 ) ♦ 23)  +  1 
TOTIM  =  TIME  t  TMIND 
IPARM<2)  =  NUMTK 
IPARM(3>=IUNIT(NUNIT*3> 

IPARM( 4 ) =ITRUCK( NUMTK ; 5 ) 

C***»  SCHEDULE  ASPARV  FOR  EMPTY  TRUCK 

CALL  SCHEIK 5» IPARM » TOTIM  )  3  ASPARV 

C 

C**«*  DECREMENT  UNIT  AMMO  ON  TRUCKS 

IUNIT(NUNIT»K+8>  =  IUNIT(NUNITfK+3)  -  NOFF 
IF  ( IUNIT (NUNIT »K+8) . LT.O)  IUNIT(NUNIT»KtS>=0 
ITRUCK(NUMTK74)  =  0 

C****  THIS  LOGIC  IS  HERE  TO  SOLVE  THE  PROBLEM  OF  WEAPON 
C****  SYSTEMS  HAVING  DIFFERENT  BASIC  LOAfiS  FOR  THE  SAME  AMMO 

IF ( IUNIT (NUNIT > 1 ) ,NE. 1  .AND.  IUNIT( NUNIT » 1 ) . NE . 2 >  GO  TO  30 
IF ( IUNIT ( NUNIT » K ) . NE . 2 )  GO  TO  30 
DO  50  JJ=87LPPAR<6)  *  13  -  S f 13 
IF(K.EQ.JJ)  30  TO  50 
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50  CONTINUE 

C  NO  EQUAL  AMMO  FOUND  FOR  2  IN  THIS  UNIT  GO  TO  30 
GO  TO  30 
C 

60  IUNIT(NUNIT,JJ+3)=IUNIT(NUNIT, JJ+3>-  NOFF 
IF ( IUNIT < NUNIT, JJ+8) . LT . 0 ) IUNI T < NUNIT , J J+3 ) =0 
GO  TO  30 

90  MX  =  ITRUCK(NUMTK,5) 

ITRUCK(NUMTK,3)  =  0 
IPARM(2)  =  NUMTK 

C***»  CALCULATE  THE  TRUCK  AMMO  LOAD 

LOAD  =  1  IMIX(  MX  *  I  AM )  *  ITRUCK  ( NUMTK ,  6 )  +  999?)  /  10000 
NRPU  =  ND  /  IUNITT NUNIT ,  K+2) 

C***»  CALCULATE  THE  NUMBER  OF  WEAPONS  LOADED  PER  TRUCK 
NU  *  MINO  ( LOAD  /  NRPU,  IUNITT  NUNIT  ,  K  +  2  >  > 

C****  CALCULATE  THE  TRAVEL  TIME 

TVLTIM  =  2  *  IRSTMET  IAM»3)  +  (NW  *  1)  *  IRSTME ( IAH  , 1 ) 

CALL  OPERA ( NUMTK , TVLTIM, TFAIL ) 

IF ( TFAIL  .GT.  0 ) THEN 
IPARMT3)  =  0 
IPARMT4)  =  666 

CALL  SCHED(8f IPARM.TIME  +  TFAIL)  8  UNTARV 

GO  TO  30 
END  IF 

DELAY  =  TVLTIM  +  IRSTMET IAM»2)  *  NRPW/100 
C**t*  CHECK  AMMO  DEMAND  AGAINST  TRUCK  LOAD 
IF(MX.E3.9)G0  TO  92 
IF(ND  .LT.  LOAD)THEN 

C***»  CALCULATE  THE  PARTIAL  LOAD  OF  THE  TRUCK 

ITRUCK ( NUMTK  » 6 )  =  10000  *  (LOAD  -  ND ) / IMIX ( MX r I AM ) 

NEWLD  3  ND 

kind  =  a 

GO  TO  33 
END  IF 
C 

92  ITRUCK(NUMTK*6)  =  0 
NEULD  =  LOAD 
KIND  =  3 
IF ( NX .EG .9) THEN 
DELAY  =  20. 

NU  =  IUNIT (NUNIT  ,K  +  2) 

END  IF 
C 

38  TOTIM  =  TIME  +  DELAY 
C **X*  CHECK  PARTIAL  LOAD  ON  TRUCK 

IF  ( ITRUCK( NUMTK » 6 )  .GT.  1000)G0  TO  42 

IF  ( IUNIT  <  NUNIT » 1 )  .EQ.  3  .AND.  ITRUCK  (  NUMTK  , 6 )  .EQ.  O'/GO  TO  4 

IPLOAD  =  ( IMIX ( MX > IAM )  *  ITRUCK (NUMTK ,6 )  +  99991/10000 

IUNIT ( NUNIT  ,K  +  4 )  *  IUNIT <  NUNIT  ,K  +  4 )  +  IPLOAD 

IUNIT ( NUNIT  *  K  +  3 )  =  IUNIT(NUNIT,K+8)  -  IPLOAD 

IF < IUNIT (NUNIT »K+8) .LT.O) IUNIT (NUNIT  »K+8)=0 

KIND  =  3 

ITRUCK ( NUMTK » 6 )  =  0 
I  FARM ( 3 )  =  0 
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70TIM  =  TOTIM  +  (IRSTHECK»2>  *  IPLOAii/ 100 ) 

C***X  SCHEDULE  A  UNTAR V  OR  UNTDEF  DEPENDING  ON  UALUE  OF  KIND 
42  CALL  SCHED(KIND» IP ARM » TOTIM  )  9  UN l DEP/UNTARV 

C 

ITRUCK < NUMTK >  11 )  =  ITRUCK(NUHTK» 11 )  4  1  9  RELOAD  COUNTER 
C**«  ADD  THE  DELAY  TO  THE  TOTAL  RELOAD  TINE  SPENT  BY  TH f 5  TYPE  UNI 
JUNIT ( I UN  IT ( NUNIT t 1 ) » 21 )  =  JUNIT ( IUNtl (NUN  IT  *  1 )  *21  i 
2  +  (TOTIM  -  TINE ) 

Cm*  ADJUST  AMMO  ON  TRUCKS  AND  CURRENT  AMMO  SUPPLY 
IUNIT ( NUNIT *K+3 )  =  IUNIT(NUNIT»K+8)  -  NE'JLD 
IFi IUNIT  < NUN  IT  >K+8) .LT.O) IUNIT (NUN  IT  *K+3>=0 
C***»  THIS  LOGIC  IS  HERE  TO  SOLVE  THE  PROBLEM  OF  WEAPON 
Cm*  SYSTEMS  HAVING  DIFFERENT  BASIC  LOADS  FOR  THE  SAME  AMMO 

IF ( IUNIT ( NUNIT » 1 ). NE » 1  .AND.  IUNIT ( NUNIT , 1 )  .NE . 2 >  GO  TO  130 
IF ( IUNIT ( NUNIT *K) ,NE. 2)  GO  TO  130 
DO  110  JJ=8»LPPAR(A)  *  13  -  5» 13 
IF(K.EQ.JJ)  GO  TO  110 

IF ( IUNIT (NUNIT »K) .EQ. IUNIT (NUNIT » JJ) )  GO  TO  120 
110  CONTINUE 
C 

C  NO  EQUAL  AMMO  2  IN  THIS  UNIT  GO  TO  45 
GO  TO  130 

120  IUNIT (NUNIT »JJ+8)* IUNIT (NUNIT* JJ+8) -NEWLD 

IF  ( IUNIT < NUNIT »JJ+9> .LT.O) IUNIT (NUNIT, JJ+8) =0 
130  IUNIT ( NUNIT  »K+4 )  =  IUNIT ( NUNIT»K  +  4  )  +  NEWLD 

IF ( IUNIT (NUNIT »K+4)  .LE.  0)WRITE(6*i35)NUNITt IUNIT(NUNIT.K) , 

*  IUNIT (NUNIT  >K+4) ? TIME 

135  FORMAT  ( '  UNIT', 13,'  AMMO' » I3» '  CUR  SUP', 110,'  AT  TIMK',F8.1> 

C  DECREMENT  THE  NUMBER  OF  ROUNDS  SHORT 

IUNIT (NUNIT >K+3)  =  IUNIT(NUNIT»K+3>  -  NEWLD 

IF ( IUNIT ( NUNIT ,  KP3 )  .LE.  0 ) IUNIT( NUNIT »K+3)  =  0 

IF  < IUNIT (NUNITtK+4 ) .GE. IUNIT (NUNIT  »K+1)*IUNIT<  NUNIT  , K+7> ) 

$  IUNIT (NUNIT  »K+3)  =  0 
IUNIT (NUNIT >K+2)  =  IUNIT ( NUNIT »K  +  2 )  -  NU 
GO  TO  10 
130  CONTINUE 
C 

RETURN 

END 


00 


SUBROUTINE  REPORT 
subroutine  report ( iP3rm i 
CM**  URITES  REPORTS  OF  VARIOUS  TYPES. 

C  EVENT  TYPE  17 

C  CALLED  BY  MAINARM.  CONTRL 

C  CALLS  TRUCK 

C***X  J  FOX  FEB  79 

CHARACTER*10  AUNIT.IUPN.  NAME.  ISAVE 
include  loa.LIST 
include  3unit.LIST 

DIMENSION  IPARM(5)»IWPN(22)»jtrks(8)»IRTYPE(7> 

C 

DATA  IUPN/  'TANK '  » '  TOW' .  'PUDR' . '155HE' . '  155ICM' . '8inrtE '  . 

S  'SinICH' > 'SinPUDR' » 'HELLFIRE' . 'HLRS' » '155RAP' . ' 135CLUP ' r ' 155 
$  ' 30mm<  AAH) ' . ' 8inRAP ' » ' MORTAR ' » ' BUSHMASTER ' » ' D I VAD ' » ' SMAI  LARM 
i  ' FUZES ' » ' 155GB ' »  ' 8ING8 ' / 

DATA  IRTYPE  / 1 . 1 . 1 . 1  *  1 » 1 > 1/ 

15  CONTINUE 

10  FORMAT  ('  1)  UNIT  STATUS'./. 

Z  '  2)  ATP  STATUS' »/. 

Z  '  3)  ASP  STATUS' ./. 

Z  '  4)  CSA  STATUS'./. 

Z  '  5)  ATP  AMMO  ISSUED'./. 

Z  '  a)  ASP  AMMO  ISSUED' ./> 

Z  '  7)  TRUCK  MOVEMENT  './» 

Z  '  8)  DEFAULT  '»/, 

Z  '  9)  ALL') 

NASP  *  0 

NATP  *  0 

IRPT  =  IF'ARM(l) 

IF(IRPT  .LT.  1  .OR.  IRPT  .GT.  9)  THEN 
WRITE<6» 10 ) 

READ*. IRPT 
END  IF 

IF  (IRPT  ,EQ.  0)  RETURN 
IF( IRPT  .EQ.  9)  THEN 
DO  20  I  =  1.7 
20  IRTYPE  < I )  =  1 

END  IF 

IF  (IRPT  .LE.  7)  THEN 
DO  30  I  =  1.7 
30  IRTYPE  (I)  =  0 

IRTYPE(IRPT)  =  1 
IRPT  =  0 


END  IF 

IFC IRTYPE ( 1 ) 

.GE. 

1) 

CALL 

RPTOl ( IRTYPE ( 1 ) ) 

IF( IRTYPE(2) 

.EQ. 

1) 

CALL 

RPT02(NATP) 

IF ( IRTYPE ( 3 ) 

.EQ. 

1) 

CALL 

RPT03(NASP) 

IF(IRTYPE(4) 

.EG. 

1) 

CALL 

RPT04 

IF ( IRTYP£(5) 

.EQ. 

1  > 

CALL 

RPT05 ( NATP ) 

IF ( IRTYPE ( 6  > 

.EQ. 

1) 

CALL 

RPT06( NASP ) 

IF( IRTYPE( 7 ) 

.EQ. 

1) 

CALL 

RPT07 

IF ( IRPT  .EQ. 
PRINT*.'  E 

0)  THEN 

NTER  ZERO  TO 

STOP  ' 
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END  IF 
RETURN 
r 

C 

SUBROUTINE  RRTOl ( IANS ) 

C  REPORT  TYPE  ONE 
C$**$  IUNIT  REPORT 

150  FORMAT (/»  '  UNIT  STATUS  PRINT  OPTIONS:  '»/» 

*  '  1  -  PRINT  ALL'f/t 

$  '  2  -  SINGLE  UNIT',/* 

*  '  3  -  RETURN' » / f 

$  '  ? ' ) 

!F( IANS.LT . 1 .OR . IANS .GT .2)  THEN 
URITE<6»150> 

READ! 5»*> IANS 
END  IF 

GO  TO  ( 160 » 240» 230 )  IANS 
C****  LOOP  THROUGH  UNITS 


160  DO  220  I  =  1 >  75 
C****  IF  NO  TYPE  CODE  BYPASS 

IF ( IUNIT ( I > 1 )  .EQ.  0)G0  TO  220 
C:****  IF  NO  UNIT  NAME  GO  TO  400 

IF  ( AUNIT  <  I.*2>  .EQ. '  ')  GO  TO  220 

C ****  PRINT  HEADER 
WRITE ( 14 » 170) 

170  FORMAT ( 42X  j /// * '  UNIT  STATUS'  * 43X» 'UNIT  DATA' »  29  X t 'WPN  DATA' »// 
*»15X» 'AMMO-CODE  UPN-TYP  UPN-ALIVE  CUR-SUP  RNDS-ONWAY  PCBL-W  ON- 
*TRKS  NO  WPN  SH  /  NO  SH  EA  TOT-DMD  '  ) 

WRITE! 14 t 130>AUNIT(I*2)t I » IUNIT! I f 1 > , IUNIT < I f2> » IUNIT ( I » 4 > , 

*  IUNIT!If3)fIUNIT(If5)fIUNIT!If7) 

130  F0RMAT(1XfA10f2I3f/f'  SFR  ATP  'fI2fI3f'  KM'f/f'  SER  ASP  ' » 12 » 13 » " 
5KM' f/»  '  NO  HELD  ' fI2> 

DO  210  J  =  1 f  LPPAR ( 6 ) 

JJ  =  13  *  J  -  5 

IF ( IUNIT ! I » JJ)  .EQ.  0)G0  TO  210 
NMSHT=0 


IF i IUNIT ( I f JJ+2) .EQ.O)  30  TO  190 
NM3HT  =  IUNIT ( I f JJ+3)  /  IUNIT! I f JJ+2) 

190  CONTINUE 

IPCBL*100*IUNIT(IfJJ+4)/(IUNIT!If JJ+1 ) *IUNIT( I f JJ+7) ) 

WRITE! 14f200) IUNIT! I fJJ)fIWPN! IUNIT! I fJJ)>f IUNIT! If JJtl) fIUNIT! 
*  I  f  JJ+4 )  f  IUNIT!  I  f  JJ+12)  f  IF'CBLf  IUNIT!  I  f  JJ+S)  f  IUNIT!  I  f  JJ+2)  fNMSHTf 
i  IUNIT ! I f JJ+11 ) 


200  F0RMAT(18XfI3f6XfA8fI7fI8f5XfI5f4XfI6f2XfI5f3XfI4f 


5x  *  i: 


210  CONTINUE 

Cttt*  PRINT  STATUS  OF  UNIT  TRUCKS 
CALL  TRUCK  (I) 

220  CONTINUE 


230  RETURN 
240  WRITE(6f250) 

250  FORMAT!'  ENTER  JIFFY  UNIT  ID  (INPUT  0  TO  EXIT)  ') 
READ(5»260>  NAME 
IF  (NAME  .EQ.  '0')  RETURN 
260  FORMAT < A10 ) 
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o  o  o 


IF ( IUNIT ( K » 1 ) .EQ.O)  50  TO  270 
IF ( AUNIT ( K  ,2) .EQ .NAME)  GO  TO  290 
270  CONTINUE 

WRITE' 6, 280)  NAME 

230  FORMAT < '  UNIT  ',A10,'  NOT  FOUND') 

GO  TO  240 

290  WRITE( 14,300)  NAME 

300  FORMAT (/, IX, 'UNIT' »1X»A10»4X» 'UNIT  DATA ' , 22X » ' WPN  DATA',/,10X» 
«  ' WPN' » 10X > ' RND3 ' , 13X  > '  *  WPN  *  RND' ,/ , IX , ' WPN-TYP' ,2X » 

*  'HUE  CUR-SUP  ONWAY  PCBL  ON-TRKS' ,3X, ' SHORT  SH  EA  TQT-OHD ' ) 
DO  320  KK=8 , LF'P AR (  6 )  *  13  -  5,13 
IF ( IUNIT (K,KK) .EQ.O)  GO  TO  320 
NMSHT= IUNIT (K»KK+3) /IUNIT (K»KK+2) 

I PCBL= 100*1  UNIT < N  , KK 4-4  )/  ( IUNIT  ( K , KK+1  >  4IUNIT >  K , KK  +  7 > ) 

WRITE (14,310)  I WPN ( IUNIT ( K  »KK )), IUNIT ( K » KK  +  1 ), IUNIT (K » KK  +  4 ) » 

4  IUNIT (K,KK+3> » IPCBL, IUNIT (K,KK+8) » IUNIT <  K,KK+2) , NMSHT , 
i  IUNIT (K»KK+11 ) 

310  FORMAT (1X»A8»1X*I3»2X,I6*2X»I5*2X,I3,2X»I6,4X,I4,2X,I5,1X,I5) 
320  CONTINUE 

C#***  PRINT  STATUS  OF  UNIT  TRUCKS 
CALL  TRUCK  (K) 

GO  TO  240 
C  RETURN 


SUBROUTINE  RHT02<  NATP ) 

C****  REPORT  TYPE  TWO 
C  ATP  STATUS 

WRITE  (6,*)  '  ENTER  NUMB  OF  ACTIVE  ATPS  ( 1 ,2, . . .0R10 ) ' 

READ  (5,*)  NATP 

IF  (NATP  ,LT .  1  .OR.  NATP  .GT.  10)  NATP  =  10 
DO  380  I  =  1 »NATP 

WRITE (  14, 350) I, I  ATP (1, 14), I ATP (1, 15) 

350  FORMAT (//// , 25X , '  ATP  STATUS  ',//,3X,'ATP  NO  ',13,//, 

*  10X, 'QUEUE  ARTY  MU',/,10X, 

t  'TRUCKS  IN  Q'  , 

*  5X» 13, 8X, 13, //,10X,' AMMO-CODE  AHT-O/H  CUR-DHD  ON-THE-WAY') 
DO  370  J  =  1,11 

JJ  =  J  *  3  +  IS 

«KITE(  14,360)  J,  I ATP(  I ,  JJ) , IATP( I » JJ+1 )  *  IATP(  I ,  J.I+2) 

360  FORMAT < 13X , I3,4X , I3,2X , I6,5X, 16) 

370  CONTINUE 
380  CONTINUE 

urite<14*382) 

382  format(////»37:;»  'ate  aueue  information '»// , 

2  5x,'ate  nu*'  ,5x,  'trfcs  served'  ,5x,  'avs  time' ,5:: > 'max  time', 

2  5x> '  trks  served' »3x, 'ava  time' ,5;;, 'max  time',/, 

2  16x , ' manuver  Queue' »5x* ' in  Queue' »5x» ' in  aueue', 

2  5::,'  arty  aueue  ',5:;, 'in  Queue ',  5x*  '  in  aueue*' 

do  334  J=l«nate 

writs(  14 , 383)  J,  jate(  J ,  1 ) ,  Jati»(  J* 2)  / J3t.° '  ) ,  1 ) ,  Jati»<  j , 3) , 

2  JatM J,4) ,JatP<  J*5)/JatM  j,4) » JatM  j»o) 

383  format(7:<,i2,ll:;,i4,ll:;,i4,9x,i4,9':,i4,12x,i4,9x,i4) 
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RETURN 


C 

C:m* 

c  **** 


ex*** 


ASP-NQ 


C  **** 
C  ***t 


SUBROUTINE  RPT03(NASP) 

REPORT  TYPC  THREE 
I ASP  REPORT 

WRITE  .(6t*)  '  ENTER  NUMBER  OF  ACTIVE  ASPS  ( 1  »2 » . . .  QRIO ) 
READ  (5**)  NASP 

IF  (NASP  .IE.  0  .OR.  NASP  .GT.  10  )NASP  =  10 
DO  430  I  *  1.  NASP 
OUTPUT  INFO 

WRITE(14» 400)1+10? IASP( I? 12) » IASP( I » 13) 
F0RMAT(1X?////?25X? '  ASP  STATUS  '?///?5X?'  ASP-NO  ' 
l  15X? ' QUEUE  ROUTINE  MLRS'?/? 

i  10X? ' TRUCKS  IN  Q'»5XfI5»3XfI5»///»'  INVENTORY an , 
i  ’ AMMO-CODE  AMT-O/H  DEMAND  ON-THE-UAY') 

DO  420  J  =  lrLPPAR(l) 

JJ  =  J  *  3  +  IS 

WRITE* 14? 410) J?IASP(I?JJ> ?IASP(I?JJ+l)?IA3P(I?JJ+7> 
F0RMAT(19X?I3?4X?I3?2XtI7?4X?I7) 

CONTINUE 
CONTINUE 
RETURN 


SUBROUTINE  RPT04 
REPORT  TYPE  FOUR 
ICSA  REPORT 
URITE< 14?450) 

FORMAT  < IX  ?////? 1 5X  ? '  CSA-STATUS  '»//?20X? 
i  / 2 1 X » '  AMMO  '  ? 10X  ? ' NUMBER-DRAWN  ') 

DO  470  I  =  1 ? LPPAR ( 1 ) 

WRITE( 14  ?460 > I ? ICSA( 3 1 1 ) 

FORMAT (22X  ? 13  ? 14X  ? IS) 

CONTINUE 

RETURN 


ROUNDS  DRAWN  FROM  CSA 


Ctttt 

C  *■«** 
C**** 
C  tiz* 


SUBROUTINE  PPTOS(NATP) 

REPORT  TYPE  FIVE 

IATPAM  REPORT  -  AMMO  ISSUED  BY  ATFS 
LOOP  THROUGH  ATFS 
WRITE  HEADERS 
WRITE  ( 14? 530) 

FORMAT ( 1X?///»30X? '  AMMO  ISSUED  BY  ATP 
l  'trucks  bumped  to  ssp  '?/? 5::*  '3 

S  5  6  7  3  9  10  11 

H3  19  20 '  > 

do  550  i  *  1 ? NATP 


ssp  '?/?5::* 

9  10  11 


'3tP  no. 
12  i: 


O'  oi 


1  IATF’AM  (1,5),  I A  TP  Art  (1,6)  ,  1  ATP  Art  (1,7),  I  ATP  Art  ( 1 , 3  > , I  A  i  PArt  ■  I ,  9  ) . 

*  I ATPAM(  I » 10 ) » I ATPArt  ( I » 1 1 ) » I ATF'AM ( I » 12 ) » I  ATPAM<  1 , 13 )  ,  TATPAH(  I , 

5  1 4 ) » iatPaan  i » 15 ) » i3tP3m < i » 16 i » iatpsm ( i , 17 ) » i3tP3» ( i • 13 ) * 

*  latpaal i » 19) » latpam ( i ,20 ) 

540  FORHAT  ( 7X, I2»5X ,2015) 

550  CONTINUE 
RETURN 
C 
C 
C 

SUBROUTINE  RPTOa(NASP) 

C*XX*  REPORT  TYPE  SEVEN 

IF  (NASP.LE.0.0R.NASP.GT.6)  HASP  =  a 
Ctt**  ArtrtO  REMOVED  FROM  ASPS 
C****  WRITE  HEADER 
WRITE* 14,570) 

C  LOOP  THROUGH  ASPS 
DO  600  I  =  1 , NASP 
WRITE  (  14,570)  14-10 

570  FORMAT  (//,20X»'ASP  12 » 10X , ' ArtrtO  TYPE 10X ,' ArtrtO  REMOVED '  ) 

DO  590  J=  1,23 

WRITE  (14,530)  J,IASPArt(I»J) 

530  FORMAT  ( 40X , 12 , 15X , 17 ) 

590  CONTINUE 
600  CONTINUE 

urite< 14,602) 

602  format (////> 37::, ' asp  Queue  inf ormotion ' , // , 

2  5>:»'3sp  nua' »5k» 'trks  served'  »5:<,  'av*  time' ,5:; » 'as;;  time', 

2  5>:»'trks  served' ,5::, 'ava  time ' , 5:; , '  me::  time',/, 

2  16::, '  routine  aue' ,5>: , '  in  Queue' »5>: ,' in  Queue'* 

2  5::»'asrs  aueue  ',5>:>'in  Queue' '  in  aueue'i 

do  606  J=l,nasp 

write( 14,604 ) j+10 , Jasp<  J» 1 > , Jasp< J,  2) /J3Sp ( j , 1 ) , jssp <  j  » 3 ) » 

2  Jasp( J , 4 ) , Janp ( J, 5) / Jasp( J*  4 ) ,  Jasp ( J , 6 ) 

604  f ornat  ( 7:: ,  i 2 , 1 1:: » i  4 , 1 1;:,  i  4 , 9:« >  i  4 , 9v: >  i  4 , 12:: ,  i 4 ,  *  i 4  > 

606  continue 
RETURN 
C 
C 
C 

SUBROUTINE  RPT07 
C***X  REPORT  TYPE  SEVEN 

C*XX*  TRUCKS  THAT  HAVE  BEEN  KILLED  OR  HAVE  BROKEN 
CX**X  LOOP  THROUGH  TRUCKS  FOR  DEAD  HR  BROKEN 
DO  650  I  =  1 ,LPPAR  <  4 ) 

C**t*  IF  NOT  DEAD,  GO  TO  630 

IF < ITRUCK < 1 , 3 )  .NE.  7)G0  TO  630 
C ****  HAVE  DEAD  TRUCK,  PRINT  NUT 

WRITE <  14, 620)1, AUNIT( ITRUCK- 1,4), 2) , I  TRUCK ( 1,1)  ,  ITRUCK (1-5) 

620  FORMAT ( '  TRUCK  NUMB', 14,'  OF  UNIT  ',A10,'  WHICH  IS  TYPE  '14,'  C 
4YING  ArtrtN' ,14,  '  IS  DEAD  '  ) 

GO  TO  650 
630  CONTINUE 

C*X**  IF  NOT  BEING  REPAIRED  GO  TO  650 


i  f  ! it  ruck  ( 1 * 3 )  .  ne .  6  .and,  itruck  <  i*  1 )  .ea.  1  .AND. 

Z  ITRUCK (1*4)  .ME.  0) 

2  Jtrksi iunit! itruck! i *  4) *  1; *  =  Jtrks  ! iun.it  ( itruck  ( l * 4 ) .  1 ;  ;•  ~  1 
IF <  ITRUCK ( 1*3)  .ME.  6)  GO  TO  550 
CtttX  HAVE  BROKEN  TRUCK*  PRINT  INFO 
ISAVE=AUNIT ( ITRUCK ! I  *  4 ) *  2 ) 

IF( ITRUCK ( 1 ,2)  .ME. 1)  ISAUE*' NON-UNIT ’ 

WRITE ( 14 * 640) I » ISAUE * ITRUCK (1*1) * ITRUCK ( I » 5  > 

640  FORMAT'.'  TRUCK  NUMB' *14,.'  OF  UNIT  ',A10*'  WHICH  IS  TYPE  '*13* 

*  ‘'CARRYING  AMriO  MIX', 14,'  IS  BEING  REPAIRED ' ) 

630  CONTINUE 

do  655  k  =  l*8 

junit (k*22>  =  Jtrks(k)  t  tcilna  +  junitCk ,22)' 
o55  continue 

write! 14*520) 

920  format!////, 46::* 'unit  truck  resupply  information 
z  (riaht  three  times  in  hours)'*//* 
z  3:; *' unit '  *5;;* ' trips  to'  *5;;> '  ava  trip '* 5" *' trips  to'  *5«> 

2  '  avs  trip' *5v.* 'percent' *3:;* '  time  for  '*5::*'total  time'* 

2  5;:»  'slack'  *5:;>  'percent'  */* 

2  5:; « 'type' *5:;* '  an  atp  '*5:;*'  time  '*5 >:*'  an  asp  '*3;;* 

z  '  time  '  *5;;*  'to  3Sps'  ,5;;,  'upn  reload'  ,3;:>  'available'  > 

2  5x*'time  '*5:;*'  slack') 
do  940  J=l*8 

c  find  the  average  turn  around  for  atr  and  asp  trips 

katpt  =  Junit! J,4)/Junit!J*l)  +  Junit ( J* 16 ) /Junit ( J *  13 ) 
kaspt  =  Junit! J, 8) /Junit! J, 5)  r  Junit ! j *20 )/ Junit ! J *  17 ) 
c  find  the  slack  time 

kslack  =  ( Junit ( J  *  22) -Junit <  J*21 ) -Junit ( J*  20) -Junit ( j  *  16 ) 

2  -Junit ( J*12)-Junit( J*8)-Junit(J*4> )/60 
kpasp  =  Junit!J*17)  *  100  /  ! JuniU J* 17)  +  Junit! J » 1 3 > ) 
write! 14*930 ) J* Junit ( J  *  13) *k  at?t  *  Junit ( J • 17 ) *  kaspt * 

2  k?asp*  Junit!  J*  21  )/60*  Junit!  j*22)/'60* 

2  kslack* ( kslack *60*1 00/ Junit! J* 72) ) 

930  format  ( 6x*  i2*6>;  *  i4  *?:;,  i4*  9;<*  i4  *9-/. *  i4*  10:<>  i3*  10:; >  i5>?:; *  i7 * 7;; * 

2  i  5  *  7 ; :  *  i  3 ) 

940  continue 

do  980  J  =  1 *  8 
write! 14*950)  J 

950  format!//// * 10x» 'truck  movement  d3t3  for  unit  type'»i2*//* 

2  5 «* '  type '  *5:: *  'trucks'  *5:;> '  trucks '  *5:: *  'trucks'  *5::  * '  avs  travel ' » /  * 
2  5x* 'move' *5«* '  sent  '  >5:<*  'killed'  *5:;*  'failed'  *3:;* '  tim*-') 

do  970  k  =  1  *  5 

write!  14*960)k*  Junit  ( J*  4*k-3 )  *  Junit  !J*4*k.-2)  •  Junit!  j  *4. *k-l  *  • 


2  Jun  i t ! J , 4*k ) / Jun i t ( J  *  4 *k-3 ) 

960  format!  6:<*  i  1  *  7:;  >  14*7;;*  i3*  7:<*  13*  10:;*  i4 ) 

970  continue 
980  continue 

wri te<  14  *  990 ) Junit ( 1  *  23  > * Junit (2*23)*  Junit! 3*23)*  Junit! 4*23'* 
2  Junit (5*23) * Jun i t( 6*23) * Junit! 7*  23) * junit ! 8*73 ) 


990 


format  (////*  18::  *' truck  s  killed  durins  reload  *//*3  ::* 
6;;  *  '  2  '  *  6::  * '  3 '  *  6::  *  '  4  *  6:;  * '  5  '  *  6::  • '  6  '  *  6::  *  '  7 '  *  6::  *  '  3  *  / 
trucks  -  '  *  i2*5::»  i2*5::*  i2* 5:; n2 *5"  n2*5;:*  i2*5;: *  i 


unit 

.5;;* 

2 *  5" » i2  -■ 


c 
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URITE  (13.11) 

11  FORMAT (//» 10X » 'EMPTY  SiP  TRAILERS  AT  C3A ' » /  / 

A9X » ' 3iP  NO' . 3X . ' OWNER ' .?X. 'MIX' ,/) 

DO  25  1 11*336 .1211 
C**«****IF  NOT  IN  CSA  DROP  THROUGH 

I F  < I  TRUCK (III. 3) . NE . 3>GG  TO  25 
UR I IE ( 18.35) I II » ITRUCK  < II 1 1 4) » I TRUCK ( III .5) 
35  FORMAT (10X. 14. 10X. 13. 10X. 12) 

25  CONTINUE 

C 

C*****:********:*PRINT  EMPTY  S4P  TRAILERS  AT  ATFS 
UR  I TEC  18.22) 

22  F0RMATC//.10X. 'EMPTY  SJP  TRAILERS  AT  ATP ' . // 

A9X. 'SJP  NO' .3X . ' OUNFR ' »9X. 'MIX' ./) 

DO  55  JJJ=835 .1211 
IF ( ITRUCK ( JJJ. 3 ) . NE .2 )GO  TO  55 
IFCITRUCM JJJ.6) .NE.O)GO  TO  55 
URITE( 18.35) JJJ. ITRUCK (JJJ. 4). ITRUCK (JJJ. 5) 
55  CONTINUE 

return 
end 


n  o  a  n  n  n  o  n  o  o  o 


SUBROUTINE  SCHED 

SUBROUTINE  SCHED  ( I  TYPE  ,  I FARM*  TIME) 

C***«  INTERFACE  ROUTINE  TO  SCHEDULE  EVENT 

CALLED  BY  ASF*  ASF'ARl*  ASPAR2,  ASF'ARV*  ASF'CK*  ATP*  ATPAR1*  AIPAR2* 
ATPARV  *  CONTRL.  CREEVT  *  CSAARV*  CSAOEP*  DEMAND  *  DEPASP, 
DUALMX *  HELARV*  INIT*  RDItXQ*  ROJIFF*  RELOAD*  SERVER* 
SEVENT*  UNTARV,  UNTDEP 

CALLS  LQQKEVI TO  PRINT  EVT),  PUTEVT (TO  PUT  EVT  IN  Q),  CONTRL 


***#  H.  JONES 


DEC  73 


LOCAL  VARIABLESING  COMMON) 

TIME  —  TIME  THAT  EVENT  IS  TO  HAPPEN*  NOT  CURRENT  TIME' 
C  ITH  —  TIME  IN  WHOLE  MINUTES 

C  ITS  —  TIME  (FRACTIONAL  PART  *  3600) 

C  ICHECK--  0*  FUTEVT  RETURNED  NORMALLY.  >0*  ABNORMAL. 

C 

DIMENSION  IPARMC5) 

IPARM(5)=ITYPE 

CALL  LOOKEV  (ITYPE+O*  IPARM*  TIME+O.*  0) 

ITH  =  TIME 

ITS  =  (TIME  -  ITH)  *  3600 

CALL  PUTEVT  (IPARM,  ITH*  ITS*  ICHECK) 

IF ( ICHECK  .ME.  0)  THEN 
WRITE ( 6 * 30 )  ICHECK 
CALL  CONTRL(TIME) 

END  IF 
C 

RETURN 

30  FORMAT ( '  TOO  MANY  EVENTS  —  '*16; 

END 
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SUBROUTINE  SERVER 
SUBROUTINE  SERVER ( IPARM > 


Cx*X* 


c 

c 

c 

c 

c 

C***x 


C 

C  XXXX 


C 

C 

c 

cm* 

cm* 

cm* 

c 

C*x** 


c 

c 

c 

c 

c 

c 

c 


THIS  ROUTINE  PROCESSES  A  SERVER  WHEN  IT  BECOMES  AVAILABLE. 

IT  CHECKS  THE  WAIT  QUEUES  FOR  TRUCKS  AND  SCHEDULES  A  RESUPPLY 
EVENT  —  ATP  OR  ASP  IF  AN  APPROPRIATE  TYPE  IS  FOUND.  IF 
NONE  IS  FOUND,  THE  SERVER  IS  PUT  INTO  ITS  WAITING  QUEUE. 

CALLED  BY  ASPAR2 ,  UNTARV 

CALLS  PUTQUE,  SCHED,  QETQIJE ,  IQ,  FINTK,  OPERA 
LOREN  IVERSON  NOV  81 

SCHEDULES  --  ATP,  LOADING  OF  A  UNIT  RESUPPLY  TRUCK 
ASP,  LOADING  OF  A  UNIT  RESUPPLY  TRUCK 
ASF'ARl ,  SERVER  AND  S*P  INTO  THE  ASP 
ASPAR2 ,  RETURN  OF  EMPTY  $JP 
UNTARV.  RETURN  OF  IDLE  SERVER 

IPARM(l)  =  ATP  -  ASP  NUMBER 
IPARM(  2  •'  =  SERVER  NUMRER 

I?ARM<  3)  *  FLAG,  EQUALS  1  IE  SERVER  IS  FROM  AMP,  0  IF  FROM  ATP 
LOCAL  VARIABLES 

MANART  —  SET  TO  1  FOR  MANUEVER,  2  FOR  ARTY 

NUMTK  —  THE  NUMBER  OF  THE  SUPPLY  TRUCK  TO  BE  LOADED 

NUMQ  —  THE  QUEUE  NUMBER  FOR  SERVER 

IQUE  —  THE  QUEUE  NUMBER  FOR  UNIT  TRUCK 

NCKSP  —  THE  CHECK  TRUCK  FOR  LASP  S*P  IN  QUEUE 

DTI  ME  —  DELAY  TIME 

NTQUE  —  TIME  SPENT  IN  QUEUE 


INCLUDE  LOG, LIST 
DIMENSION  IPARM(S) 

C 

NUMSVR  =  IPARM(2) 

IAPTYP  =  IPARM ( 3 ) 

C 

C  **  CHECK  FOR  SERVER 

IF ( I TRUCK (NUMSVR, 1 ) .NE.9. AND. I TRUCK (NUMSVR, 1 ) .NE.  3>THEN 
URITE(LU0UT»5) NUMSVR 
5  FORMAT (2X« 15, '  IS  NOT  A  SERVER') 

RETURN 
END  IF 
NFLAG  =  0 

Cm*  SET  SERVER  STATUS  AS  AVAILABLE 
ITRUCK(NUMSVR,3)  *  1 


Cm*  DETERMINE  IF  THE  UNIT  IS  AN  ATP  OR  ASP(=1> 

IF ( IAPTYP  .FQ.  1)  GO  TO  40 

C 

Cm*  HAVE  AN  ATP 
NATP  =  IPARM(l) 

C  *  ■*  I  IF  EQ,  ATP  HAS  BEEN  INTERDICTED  --  PUT  SERVER  IN  5UE 


CALL  PUTQUE(NUMSVR*ISERV(3) ) 
ITRUCK ( NUMSVR  *3 )  =  ? 

RETURN 
END  IF 


C 

Cm*  IATP(NATP, 16)  IS  ATP  SERVER  REMOVAL  COUNTER 

IF  ( I  ATP  { NATP  *  16 )  .LT.  ISERV(l)  .AND.  NATP  ,NE.  TATPSDUO  THEN 
DTI ME  =  ISERV<7) 

IPARM ( 4 )  =  DTIME 


3  CALL  SCHED(8* IPARM*TIME+DTIH£) 
ITRUCK< NUMSVR* 3)  =  5 
IATP(NATP* 16)  =  IATP(NATP* 16)  +  1 
WRITE (6*9) NUMSVR »NATP*TIM£ 

9  FORMAT ( 5X* ’SERVER ' > 15* '  AT  ATP',13* 

*  '  AT  TIME' *F3.1 ) 

IF ( IATF'(NATP* 16)  .LT.  ISERV( 1 ) ) THEN 
CALL  GETQUE  ( NUMSVR  *  I  ATP  <  NATP.*  10 ) ) 
IF (NUMSVR  .EQ.  0) RETURN 
IPARM( 2)  =  NUMSVR 
GO  TO  S 
END  IF 
RETURN 
END  IF 

IF(ITRUCK( NUMSVR*!)  .EQ.  9)  GO  TO  20 


3  UNTARV 


IS  MOVING  REARWORO 


C 

C HAVE  A  FORKLIFT 
IQUE  =  I ATP  <  NATP  *  12 ) 

CALL  GETQUE (NUMTK* IQUE) 

IF<NUMTK  ,NE .  0)  THEN 

C**M  HAVE  A  MANUEVER  TRUCK  SET  UP  FOR  ATP  EVENT 


MANART  *  2 
ELSE 

IQUE  =  I ATP ( NATP* 11) 

CALL  GETQUE (NUMTK* IQUE) 

IF ( NUMTK  ,NE.  0)  THEN 
NCKTK  =  NUMTK 

12  IF ( <  ITRUCK(NUMTKfS)  .EQllO)  .OS.  <  ITRUCK(NI!MTK*5)  .EG. 40)  mHEN 

CALL  PUTQIJE ( NUMTK » IQUE ) 

CALL  GETQUE ( NUMTK » IQUE ) 

IF ( NUMTK  .EQ.  NCKTK ) THEN 
CALL  PUTQUE(NUMTK* IQUE) 

GO  TO  10 
ELSE 

GO  TO  12 


END  IF 
END  IF 

C***»  HAVE  AN  ARTY  TRUCK  SET  UP  ATP  EVENT 

MANART  =  1 
ELSE 


C***«  PUT  THE  SERVER  IN  THE  QUEUE 

10  NUMQ  =  I ATP ( NATP  *10) 

CAlL  PUTQUE* NUMSVR* NUMQ) 
RETURN 
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END  IF 
NFLAG  =  1 
GO  TO  50 

C 

C**X*  HAVE  A  CRANE 

20  IQUE  =  I  ATP ( NATP  >11) 

CALL  G£TQUE<  NUHTK * IQUE ) 

IF <  NUHTK  . NE .  0)  THEN 
NCKTK  =  NUHTK 

22  IF ( < ITRUCK ( NUHTK . 5 ) . £Q . 10  > . OR . ( I  TRUCK ( NUHTK . 5 ) . EQ . 40  > ) THEN 

CALL  PUT  QLJE  <  NUHTK . IQUE ) 

CALL  GETQUE ( NUHTK • IQUE) 

IF( NUHTK  .EQ.  NCKTK ) THEN 
CALL  F'UTQUE  <  NUHTK  *  IQUE ) 

GO  TO  25 
ELSE 

GO  TO  22 
END  IF 
END  IF 

C ****  HAVE  A  ARTY  TRUCK  SET  ATP  EVENT 

HANART  *  1 
ELSE 

C.X***  PUT  THE  SERVER  IN  THE  QUEUE 
25  NUHQ  =  IATPLNATP* 10) 

CALL  PUTQUELNUHSVRi  NUHQ) 

RETURN 
END  IF 

C 

50  HIX  *  ITRUCMNUHTK.5) 

JLOOP  =  LPPAR(l) 

DO  55  I  =  1 »LPPAR( i  ) 

IF ( IMIX ( HIX » I )  .EQ.  0 ) GO  TO  55 
IAH  =  I 
GO  TO  60 
55  CONTINUE 

u 

Ct***  CHECK  IF  AN  SiP  IS  AVAILABLE  FOR  RELOADING 
60  NATPQ  =  IQ(2.NATP> 

70  CALL  FINTKC NATPQ. IAH.NATPTK.O) 

IF ( NATPTK  .NE.  0)G0  TO  90 
IF ( NATPQ  .NE.  IQ « 3 .NATP ) ) THEN 
NATPQ  *  IQL3.NATP) 

GO  TO  70 
ELSE 

CALL  PUTQUEL NUHTK. IQUE) 

IF ( NFLAG  .EQ.  1 ) THEN 
GO  TO  10 
ELSE 

GO  TO  25 
END  IF 
END  IF 

r 

C ****  HAVE  FOUND  A  TRUCK.  PUT  BACK  IN  QUEUE 
90  CALL  PUTQIJEL NATPTK. NATPQ) 
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CJ 


cm* 


SCHEDULE  THE  AT?  EVENT 
IF'ARM  ( 4 }  =  NUMSVR 
IP ARM'S)  =  NUMTK 
IPARM'2)  =  NAT? 

IPARM(l)  =  MANART 

C ALL  SCHED \ 6 » I  FARM  >  TIME )  9  ATP 

ITRUCK ( NUMSVR  . 3 )  =  4 
RETURN 

XXX*  HAVE  AN  ASP  .  LOOK  FOR  A  TRUCK 
40  NA3P  =  IPARM(l)  -  10 

C  *  *  *  IF  EQ.  ASP  HAS  BEEN  INTERDICTED  —  PUT  SERVER  IN  SUE 
IF  UNASP  +  10)  .EQ.  ISERV<6) )THEN 
CALL  PUTQUE( NUMSVR  * ISERV <  4  > ) 

ITRUCK(NUMSVR»3)  =  9 
RETURN 
END  IF 

cm*  IASP ( NASP >16)  IS  ASP  SERVER  REMOVAL  COUNTER 

IF  < IASP < NASP >16)  .LT.  ISERV(2)  .AND.  IASP(NASP>3)  ,E3.  0)  THEN 
NRASP  =  IASP (NASP  » 1 1 )  -  10 
DIST  =  I ASP (NASP* 1 )  -  IASP ( NRASP > 1 ) 

TRTM  =  60.  *  DIST  /  ITYPE(5> IDAY+3)  +  30.  9  30  MIN  I.OAD/UNL 

IF ARM( 4 )  =  TRTM 
45  ITRUCK (NUMSVR >3)  =  3 

ITRUCK  ( NUMSVR . 4 )  =  NRASP  +  1.55 
IASP<NASP>16)  =  I ASP ( NASP » 16)  +  1 

CALL  S0HED(8> IPARM.TIME+TRTM)  9  SEND  TO  REAR  ASP(UNTASV) 

WR ITE  ( 6 » 13 )  NUMSVR  *  NASP  .  NRASP+10  .TIME 
48  FORMAT <5X.' SERVER'. 15 >'  AT  ASP '.13.'  MOVED  TO  ASP '.13. 

I  '  AT  TIME ' »F8 ♦  1 ) 

IF< IASP (NASP. 16 )  .IT.  ISERV ( 2 ) ) THFN 
CALL  GETQUE(NUMSVR.IASP( NASP . 7 ) ) 

IF ( NUMSVR  .EQ.  0 ) RETURN 
IPARM( 2  )  =  NUMSVR 
GO  TO  45 
END  IF 
RETURN 
END  IF 

C  *  X  PREPARATION  OF  HELICOPTFR  SLING  LOAD 
IF ( IASP ( NASP .15)  .GT.  0)THEN 

IASP(NASP. 15)  *  IASP (NASP .38)  -  1 
IPARM ( 4 )  «  47 

CALL  SCHED (8. IP ARM. TIME  +45.)  ?  UNTAR V 

ITRUCMNUM3VR.3)  =  4 
RETURN 
END  IF 

CXXXX  LOCATE  UNIT  TRUCK  TO  BE  LOADED 
NUMQ  »  IASP ( NASP  » 9  ) 

CALL  GETQUEt NUMTK. NIJMQ) 

IF ( NUMTK  .GT.  0)  THEN 
NCKTK  =  NUMTK 
CALL  P'JTQUE<  NUMTK  >NUMt>) 

400  CALL  GETQUE ( NUMTK . NUMQ ) 

MIX  »  ITRUCK (MtjMTK >5) 


numam  =  mix 

IF  (MIX  .GT.  LF'PAR  ( 7 )  >  NUMAM  =  MIX  -  LF'PAR  ( 7  ) 

C  *  *  *  DETERMINE  IF  SUFFICIENT  AMMO  AT  PARENT  ASP 

IF !  I  ASP ( NASP . NUMArtlSt 1 3 )  -  I  ASP  (  NASP  > NUMAM&3  +  1?)  .GE. 
i  IMIX(MIX.NUMAM)  )  THEN 

Cl***  HAVE  A  TRUCK  .  SCHEDULE  ASP  EVENT 

IPARM(l)  =  1 
IPARM<2)  =  HASP  +  10 
IPARM<3)  =  NUMTK 
IPARM(4 )  =  NUMSVR 

CALL  SCHED< 7 » IPARM. TIME)  9  ASP 

I  TRUCK ( NUMSVR » 3 )  =  4 
RETURN 
ELSE 

CALL  F'UTQUE<  NUMTK*  NUMQ) 

IF( NCKTK  .EG.  NUMTK)  GO  TO  600 
GO  TO  400 
END  IF 
ELSE 
C 

C 

C 

C  *  *  *  CHECK  FOR  ASP-ATP  SSP  TO  LOAD 
600  CALL  GETQUE(NATPSP » I Q ( 11 .NASP) ) 

IF ( NATPSP  .EG.  0)G0  TO  700 

C  *  *  *  SERVER  AVAILABLE  PUT  IN  QUEUQ  AND  SCHED  ASPAR1 
CALL  PUTQIJE ( NUMSVR . IQ ( 10  *  NASP  > ) 

NATP  =  I TRUCK ( NATPSP . 4 )  -  85 
IFARM(l)  *  NATP 
IPARM<  2 )  =  NATPSP 
IPARM<3)  =  NASP  +  10 
I FARM ( 4 )  =  0 

CALL  SCHEDQ2. IPARM, TIME)  9  ASPAR1 

C  FIND  THE  QUEUE  WAIT  TIME  AND  ADD  IT  TO  TOTAL  QUEUE  TIME 
NTOUE  =  TIME  -  ITRUCK (NATPSP, 3 > 

ITRUCK( NATPSP. 12)  =  LTRUCK< NATPSP . 12 )  +  NTQUE 
JASPCNASP.3)  =  JASP(NASP.S)  +  NTQUE 
C  IF  THIS  IS  THE  LONGEST  QUEUE  WAIT  RECORD  IT 

IF (NTQUE. GT . JASP(NASP»9) )  JASP(NASr.9)  =  NTQUE 
RETURN 
C 

C*%tXtt*rM**t*t****tt***t%Mt*****t*%***t%***%%*%*%*t**t*t.*ti;X**M**tMtX 
C******LOCK  FOR  S  i  P  TO  OFF  LOAD 
700  NUMQ  =  I  ASP (N ASF  . 4) 

CALL  GETQIIE ( NUMSP » NUMQ ) 

IF ( NUMSP . NE .0 ) GO  TO  300 
C 

C**********  NO  TRAILERS  IN  QUE » PUT  SERVER  BACK  IN  H * S  QUE 
NUMQ  =  I  ASP (NASP. 7) 

CALL  F’UTQUt(  NUMSVR  .NUMQ ) 

RETURN 
END  IF 
C 
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300  I F  < : TRUCK  <  NUMSP »  a ) . EG . 0  >  THEN 
NCKSF'  =  NUMSP 

350  CALL  ?UTQUE( NUMSP »NUNQ> 

CALL  6ETQUE (NUMSP » NUMQ ) 

IF( ITRUCK (NUMSP ,6 > . NE.OiGG  TO  900 
IF ( NUMSP. EQ.NCKSP) THEN 
CALL  PUTQUE ( NUMSP , NUMQ ) 

NUMQ  =  I ASP ( NASP , 7 ) 

CALL  F'UTQUE(NUMSVR»NUMG> 

RETURN 
END  IF 
GO  TO  350 
ELSE 

900  WRITE  (16,950  )  NUMSVR ,  NUMSP  *  ITSIJCK*  NUMSP,  5>  ;  ITRUCK (  NUMSP 

950  F0RMAT(/,10X, 'SERVER  NO. ',15,'  TS  OFFLOADING' , 15, 

1  '  MIX  ',12,  '  %  ',15,'  AT  TIME  ',F3.1> 

MIX  =  ITRUCK(NUMSP,5) 

ITRUCK(NUMSVR,3)  =  4 


|  M  t- 

i  ■  ■  »_ 


C 

zr*xtt***tt***t*****  CHECK  FOR  FAILURE  i  SCHEDULE  AVAIL.  OF  SFRVER 


TLOAD  =  IMIX(MIX,32)*  ( ITRUCK ( NUMSP , 6 >/ 10000 . ) 

CALL  OPERA (NUMSVR, TLOAD, TFAIL) 

DTI  ME  =  TIME  +  TLOAD  +  TFAIL 
CALL  SCHED(3» IP ARM, DTI ME)  9  UNTAR V 

ITRUCK ( NUMSVR , 5 )  =  ITRUCK(NUHSVR,5>  +  TLOAD 
C  TOT  TIME  OFF-LOADING  S*PS  AT  ASF 


ITRUCK ( NUMSVR , 9 )  =  ITRUCK ( NUMSVR , 9 )  +  1  0SERVER  OFF-LOAD  CNTEF; 
C 

C*xr**rt*******$  DECREMENT  AMMO  ON  TRAILER 
ITRUCK ( NUMSP , 6 )  =  0 
IPARM<2)  =  NUMSP 
IPARM<3>  *  0 
IF'ARM  ( 4 )  =  555 

IF ( TFAIL  .GT.  0.)DTIME  =  DTI ME  -  TFAIL 

CALL  SCHED(13,IPARM,DTIME)  9  ASPAR? 

END  IF 


C 


RETURN 


rr.  SUBROUTINE  SEVEN! 

SUBROUTINE  5EVENT 
C 

C***  ****:*»**#:*  #***<*:*:<<*£**:***.**:**** 

C 

C  THIS  ROUTINE  ADDS  THE  EVENTS  CREATED  SEPARTELY 
C  AND  STORED  ON  FILE  TO  ft£  SCHEDULED  (N  RUNS  OF  ARM 
C  (INPUT  THRU  EVENTSCI — ) . 

C 
C 

C  ADDED  1  MAY  32  ANN  HILLS 

C%x*$*%%t%**t%*M*illtt*%**t%t*t***tt*t%*tt***%tii*iit*% 

C 

C  VARIABLES  USED: 

C  ITYP . . , THE  TYPE  OF  EVENT 

C  I IPARMS . . . THc  PARAMETERS  OF  THE  EVENT 

C  53TIME . . . THE  TIME  THE  EVENT  IS  TO  RE  SCHEDULED 

C*4t*:**.t  :********  .**:«*****X*#***#***##:M***#*#****£*.** 

C  FILES  used: 

C  FILE  11  WHICH  CONTAINS  THE  EVENTS 

C  ROUTINES  CALLED: 

C  SCHED  TO  SCHEDULE  THE  EVENTS 

C  CALLED  BY  INIT 

C***Jm***m*4*:m:m***************<:U:m**.lu*:»( 

C 

DIMENSION  I  TYPE (500; » IPARM1 ( 500) »  TPARM2(500) » 1PAKM3 ( 
DIMENSION  IPARM4(500) , IPARM5(500) » ST I ME (500) » I IP ARM ( 

C 

C  ZERO  OUT  THE  ARRAYS 

DO  100  1=1 f 500 
ITYPE  v I ) =0 
IPARMK  I )  =0 
IPARM2 ( I ) =0 
IPARM3 ( I ) =0 
IPARM4 ( I ) =0 
IPARM5( I )=0 
3TIME(I)=0. 

100  CONTINUE 
DO  101  1=1,5 

IIPARM( I )=0 

101  CONTINUE 
r 

C 

C  NOW  READ  THE  EVENTS  FROM  FILE  11  INTO  TEMPORARY  ARRAYS 
C 

READ(ll)  ITYPE , IPARM1 » IPARM2 , IPARM3 » IPARM4 » IPARM5 ,3TIME 
C 

C  LOOP  TO  SET  ARRAY  VALUES  EQUAL  TO  NECESSARY  PARAMETERS 
C  NEEDED  fO  SCHEDULE  EVENTS.... IF  AT  THE  END  OF  THE 
C  EVENTS  GET  OUT  OF  THE  LOOP 
C 

DO  500  1=1,300 
ITYP=ITYPE(I> 


t 
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tn  c.n 


I F  < ITYP.LT .0. OR . ITYP . GT . 19  > THEN 

PRINT* » ' THE  FOLLOWING  EVENT  IS  INCORRECT' 

PRINT  12*  ITYP  .  IPARM1  ( I )  *  IPARM2 ( I )  .  IPARM3<  I  ;■ , IPASM4 
12  FORMAT ( T2 . 'EVT  #  '.12. 'WITH  FARMS  ' . 5 1 S > 

PRINT*.  'THIS  EVENT  IS  NOT  SCHEDULED' 

GO  TO  300 
END  IF 

IIPARMU)=IPARM1(I) 

IIPARM(2)=IPARM2(I) 

I IPANM (3i =IPARM3 ( I > 

IIPARM(4)=IPARM4(I) 

IIPARM(5)  =  IF‘ARM5(  I ) 

SSTIME=STIME(I) 

CALL  SCH£D( ITYP. IIPARM.SSTIME) 

500  CONTINUE 
C 

RETURN 

END 
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SUBROUTINE  SETQUE 
SUBROUTINE  SETQUE  (ITEM.  NUMQUE ) 

****  SETS  UR  NUMQUE  EMPTY  QUEUES  FOR  ITEM. 

EX.  CALL  SETQUE( 176. 1400)  CLEARS  ALL  QUEUES. 

CALLED  BY  TRKPUT 

C *#**  H.  JONES  DEC  73 
INCLUDE  QUEMUM.LIST 
INCLUDE  QUEPNT .LIST 
DO  10  1=1 .NUMQUE 
10  I  HE AD  < I )  =  0 
C 

DO  20  1=1. ITEM 
20  ITEMS ( I )  =  0 
C 

RETURN 


SUBROUTINE  TRKP'UT 
SUBROUTINE  TRKPUT 

C-****  ALLOWS  INTERACTIVE  TRUCK  QUEUE  RK-ASS ISNMENT 

w 

C  CALLED  BY  CQNTRL  '> OR  EDIT  IN  THE  EDIT  PROGRAM) 

C  CALLS  READF ,  NXTQUE ,  P'JTQUE,  uETQUE *  SETQUE »  GE70NE 

C 

C**«*  H.  JONES  FEB  79 
C 

CHARACTER*:©  IWORD 

DIMENSION  INTGR(IO) »  REAL(IO),  IWORDdO) 

C 

5  UR ITE ( 6 , 10 ) 

10  FORMAT ( IX, 'COMMAND  EXAMPLES  :'*/, 

%  IX , ' GET  3  FROM  35  '*/, 

*  IXf'PUT  3 >  10  IN  105  '*/, 

*  IX, 'LIST  105  ',/, 

$  1 X » 'TAKE  OUT  ',/, 

i  IX » ' END  ' ,  / ) 

r 

W 

20  WRITE ( 6,30) 

30  FORMAT (' 

CALL  READF  (5*  10*  INTGR*  REAL*  IWORD) 

IF ( IUORD ( 1 /  ,EQ.  'GET'  .OR.  IWORDd)  .EQ.  'G')  GO  TO  40 

IF ( IWORD ( 1 )  .EQ.  'PUT'  .OR.  IWORD(l)  .EQ.  'P')  Git  TO  60 

IF ( IWORD ( 1 )  .EQ .  'LIST'  .OR.  IWORD(l)  .EQ,  'L'>  GO  TO  80 
IF(IW0RD(1)  .EQ.  'TAKE'  .OR.  IWORD(l)  .EG.  'T')  GO  TO  110 
IF < IWORD! 1 )  .EQ.  'END'  .OR.  IWORD(l)  .EQ.  'E'>  GO  TO  120 

IF ( I !W 0 R D <  1 )  .EQ.  'HELP'  .OR.  IWORDd)  .EQ.  'H')  GO  TO  5 

PRINT*,'  WHAT?7? ' 

GO  TO  20 
C 

C#***  GET  TRUCK  FROM  QUEUE  WITHOUT  RE-ORDERING  QUEUE 
40  II  =  INTGR ( 1 ) 

12  =  INTGR  <  2 ) 

IF ( INTGR < 3 )  ,NE.  0)  THEN 
PRINT*,'  INPUT  ERROR' 

GO  TO  20 
END  IF 

CALL  GET0NEII2,  II,  IFLAG ) 

IFIIFLAG  .NE.  0 > PRINT* , 1 1 » '  NOT  GOT' 

GO  TO  20 
C 

C  *  *  *  *  PUT  TRUCK  IN  QUEUE 

60  IFdNTGRU)  .Lt.  0  .OR.  INTGR ( 2) . LE .0  .OR.  INTGR C 1 )  .ST.  1440 
PRINT*, 'RE-ENTER  ' 

GO  TO  20 
END  IF 

11  =  INTGR(l) 

12  =  INTGR (2)  • 

13  =  INTGR ( 3 ) 

IF ( INTGR < 3 )  .EQ.  0,  THEN 
13  =  INTGR ( 2 ) 

12  =  INTGR ( 1 ) 


)  THEN 


1 


r>  cj 


T  7 


» 


70 


00  70  1=11*12 
CALL  PIJTQUE  (  I 
GO  TO  20 


****  LIST  TRUCKS  IN  QUEUE 

80  CALL  NXTQIIE  (IFIRST,  INTGR(l)) 

IF (IFIRST  .EH.  0)  GO  TO  20 
90  CALL  GETQUE ( NUMTK  *  INTGR(l)) 

CALL  PUTQUE(NUMTK*  INTGR(l)) 

WRITE (6*  100)  NUMTK 
100  FORMAT ( IX, 15) 

CALL  NXTQUt  (INEXT,  INTGR <  1 ) ) 

IF ( INEXT  .NE.  IFIRST)  GO  TO  90 
GO  TO  20 
C 

Cl***  TAKE  TRUCKS  OUT  OF  QUEUES 

110  PRINT*,'  ENTER  QUEUE  NUMBER  (999  TO  TAKE  OUT  FROM  ALL  QUEUES 
READ  (3*0  IQNUM 
IF ( IQNUM  .NE.  999 ) THEN 
200  CALL  GETQUE(NUMTK, IQNUM) 

IF ( NUMTK  .EQ.  0)G0  TO  20 
GO  TO  200 
ELSE 

CALL  SETGUE< 1400* l7o ) 

END  IF 
GO  TO  20 


120  RETURN 


o  o  n  o 


SUBROUTINE  TRKTIM 
SUBROUTINE  TRKTIM 

C  INITIALIZES  TRUCKS'  TIME  TO  NEXT  FAIL' EXPONENTIAL 


DISTRIBUTION) 


CALLED  BY  INIT 
CALLS  NOTHING 

INCLUDE  LOG. LIST 
CHARACTER*3  IANS 

MR ITE( 6.10) 

10  FORMAT  (  '  INITIALIZE  TRUCKS"  TIME  SINCE  LAST  FAILURE v  ( YES/Nfi )  ' 
REAIK5.20)  IANS 
20  FORMAT ( A3 ) 

C 

IF ( IANS  .EQ.  'NO  '  .OR.  IANS  .EQ.  'N  ')  GO  TO  40 
C 

C***:#  LOOP  THROUGH  TRUCKS 

DO  30  I  =  1 »LPPAR( 4)  3  MAX  #  OF  TRUCKS 

ITYP  =  ITRUCK(I.l) 

C  IF  NOT  ACTIVE  BYPASS 

IF  (ITYP  .EQ.  0)  GO  TO  30 
C  FIND  MT3F 

XMTBF  =  ITYPE( ITYP.5) 

C  COMPUTE  TIME  TO  NEXT  FAILURE! EXPONENTIAL  DISTRIBUTION) 

UNRN  =  RANF(DUM) 

XRAN  =  <-XMTBF*ALOG(l-UNRN)> 

C  STORE  TIME  SINCE  MAINT.  FOR  THIS  TRUCK 

I  TRUCK (1.7)  =  XRAN 
30  CONTINUE 


40  RETURN 


VV.  SUBROUTINE  TRUCK 

SUBROUTINE  TRUCK  (L> 

C*:m  WRITES  STATUS  OF  UNIT  TRUCKS 
C 

C  CALLED  BY  REPORT 

C  CALLS  NOTHING 

C 

C***»  D  REMEN  JUN  79 

r 

W 

CHARACTERS  AUNIT 
INCLUDE  LOG»LIST 
INCLUDE  AUNIT *LIST 
C***»  WRITE  HEADER 

WRITE!14,10)AUNIT!L*2) 

10  FORMAT ( IX >///* 8X * '  TRUCK  STATUS  REPORT  FOR  UNIT  '*A10*///* 
$  '  TRK  NM  STATUS  MIX  PCLOAD  NXFAIL ' * / ) 

C 

C ****  LOOP  THROUGH  THE  TRUCKS 

DO  30  J  *  1  *LPPAR<  4 )  0  MAX  #  TRUCKS 

C  IF  TRUCK  NOT  OF  THIS  UNIT*  BYPASS 

IF! ITRUCK ( J*  4)  .NE.  L)GO  fO  30 

IF < ITRUCK! J*2)  .NE.  1  .AND.  ITRUCK(J»2>  .NE.  9 > RO  TO  30 
C  HAVE  TRUCK  OF  THIS  UNIT  PRINT  INFO 

WRITE! 14*20)  J*  ITRUCK!J*2>*  ITRUCK(J*3)*  ITRUCK! J*5) * 

$  ITRUCK! J*6> .  ITRUCK! J *7) 

20  FORMAT  <2X,4I7> 

30  CONTINUE 
C 

RETURN 

END 


SUBROUTINE  UNTAR V 
SUBROUTINE  UNTARV  (IPARM) 

C****  EVENT  UN T ARV  --  ARRIVAL  OR  TRUCK  AT  UNIT. 

C  (ALSO  MLRS (LEAVING  ASP/ATP),  AND  SERVERS ) 

C  FOR  UNIT  TRUCKS  *  PUT  IN  QUFUE  (NAT  GENERA 

C  A  RELOAD).  FOR  SERVERS *  CALL  SERVER  TO 

C  TO  PUT  THEM  IN  AVAILABLE  QUEUE. 

C 

C  EVENT  TYPE  8 
C  CALLED  BY  MAINARM 

C  CALLS  DEPASP»  SERVER*  IQ*  PUTQUE*  SCHED 

C 

C* ***  J.  FOX  JAN  7? 

C 

C****  IPARM' 1)  —  UNIT  NUMBER 

C****  IPARH( 2)  —  TRUCK  NUMBER  (0  OR  -1  FOR  MLRS) 

C****  IFARM(  4)  —  666  FOR  UNIT  TRUCK  FAILED  ON  RELOAD 

C 

C****  SCHEDULES  —  RELOAD  IF  DEMAND  EXISTS. 

C****  SCHEDULED  BY  —  ASP,  ASPAR1,  ATP*  DUALMX*  RELOAD*  SFRVER 
C 

C**X*  CHANGES  —  UNIT  AM.  3  ON  TRUCKS 

C  —  UNIT  TRUCK  QUEUE 

C 

INCLUDE  LOG, LIST 
DIMENSION  IPARM ( 5 ) 

C 

C*Xt*  LOCAL  VARIABLES  J 

cm*  MIX  —  INDEX  OF  AMMO  MIX 

Cm*  IND  --  INDEX  FOR  IUNIT  AMMO  TYPE 

C*m  NUMAM  —  AMMO  TYPE  FOR  UNIT  AMMO  TYPE  I 

Cm*  NUMR  —  NUMBER  OF  ROUNDS  OF  TYPE  NUMAM  ON  THE  TRUCK 

Cm*  IRESFL —  RESUPPLY  FLAG  (0  =  NO  RE3UP*  1  =  SCHED  RESUP) 

Cm*  NUMQ  —  UNIT  TRUCK  QUEUE  NUMBER 

C*m  ISTAT  —  0  IF  UNIT  TRUCK  FAILED  ON  RELOAD 

C 

NUNIT  »  IPARM <  1 ) 

NUMTK  =  IPARM(2) 

C 

CXXXX  IF  THIS  IS  A  MLRS  TRUCK  LEAVING  THE  ASP  OR  ATP  CALL  DEPASP 
IF (NUMTK  .EQ.  0  .OR.  NUMTK  ,EQ.  -1)  THEN 
CALL  DEPASPC IPARM) 

RETURN 
END  IF 
C 

cm*  CHECK  IF  THE  TRUCK  IS  A  SFRVER 

IF ( I TRUCK (NUMTK *  1 )  .EQ.  9  .OR.  ITRUCK(NUMTK*1 )  .EQ.  <?>  THEN 
CALL  SERVER (IPARM) 

RETURN 
END  IF 
C 

C****  INITIALIZE  RELOAD  FlAG 
IRESFL  *  0 
ISTAT  *  4 


C***»  DETERMINE  AMMO  MIX 

MIX  =  I  TRUCK  <  NUMTK  ,  5'< 

IF ( MIX  .LE.  0)  THEN 
WRITE ( 6 » 10 )  NUMTK 

10  FORMAT dX» 'UNTARV  —  ZERO  MIX  ON  TRUCK  '.13) 

RETURN 
END  IF 
C 

C***«  PUT  TRUCK  IN  UNIT  QUEUE 
NUMQ  =  I Q < 1 »  NUNIT) 

CALL  PUTOUE< NUMTK,  NUMQ) 

C 

IF ( ITRUCK ( NUMTK > 3 )  .LE.  1  .OR.  IPARMM)  .EQ.  6.46>!?.TAT  =  0 
ITRUCK< NUMTK.  3)  =  1 
C 

Ct*tt  ADD  AMMO  TO  UNIT  AVAILABLE  AMMO  AND  CHECK  FOR  GENERATING  RELOAD 
DO  40  I  =  l.LPPARU) 

IND  =  1*13  -  5 

NUMAM  =  IUNIT (NUNIT .  IND) 

IF(NUMAM.EQ.O)  GO  TO  40 
C 

C***»  IF  NO  AMMO  OF  THIS  TYPE  ON  TRUCK  GO  TO  40 

NUMR  =  ( IMIX< MIX , NUMAM )  *  ITRUCK ( NUMTK . 6 )  +  9???)  /  10000 
IF( NUMR  .LE.  0)  GQ  TO  40 
C 

C***»  HAVE  THIS  TYPE  OF  AMMO.  ADO  TO  UNIT 
IF(ISTAT  .NE.  4 ) GO  TO  25 

IUNIT (NUNIT ,  INO-rS)  =  IUNIT(NUNIT,IND+8)  +  NUMR 
IFdSTAT.EQ. 4)1  UNIT! NUNIT » IND  +  12 )  *  dUNITC NUNIT , IND+12 )  )-NUMR 
ITRUCK ( NUMTK. 10 )  =  ITRUCK ( NUMTK , 10 )  +  1  3  *  OF  ARVLS  FROM  ATP-ASP 
r 

C***:*  IF  NOT  A  FARP  GO  TO  30 

25  IF(IUNIT(NUNIT.1).NE.3)  GO  TO  30 

IF(IUNIT« NUNIT >IND+4).GT. IUNIT ( NUNIT, IND  +  n* IUNIT (NUNIT.  I 
*ND+7)+IUNIT(NUNIT,IND  +  l)*IUNlT(NUNIT»INl)rd) )  GO  TO  40 
C**«*  SET  RELOAD  FLAG 
IRESFL=1 
GO  TO  40 

CM***  IF  RELOAD  IS  NOT  REQUIRED  GO  TO  40,  E!  SE  3FT  RELOAD  FI  AG  =  TRESFL 
30  IF ( IUNIT (NUN IT » INO+7)  *  IUNIT ( NUNIT, IND  +  1)  .LE. 

*  IUNIT ( NUNIT » IND+4 )) GO  TO  40 


CX***  SCHEDULE  RELOAD  FLAG 

IRESFL  =  1  » 

40  CONTINUE 
IPARM ( 4 )  =  0 

IF ( IRESFL  .EQ.  1)  CALL  SCHED<2,  IPARM.  T]n£)  3  RELOAD 

C 

RETURN 

END 
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SUBROUTINE  UNTDEP 
SUBROUTINE  UNTDEP  (IPARM) 

C***»  EVENT  UNTDEP  —  DEPARTURE  OF  TRUCK  FROM  UNIT, 

C  (HAVING  BEEN  EMPTIED  IN  A  REiQAD;  MAY 

C  CHANGE  MIX  ON  THE  WAY  TO  ATP/ASP 

C 

C  EVENT  TYPE  3 
C  CALLED  BY  MAINARM 
C  CALLS  OPERA*  INTRDK »  SCHED 
C 

C***#  J.  FOX  JAN  79 
C 

Cm*  IPARM(l)  —  UNIT  NUMBER 
C#***  IPARMC2)  —  TRUCK  NUMBER 

C 

C#***  SCHEDULES  —  ATPARV*  ARRIVAL  OF  TRUCK  AT  ATP  OR 

C  —  ASPARV.  ARRIVAL  OF  TRUCK  AT  ASP 

C 

C*m  SCHEDULED  BY  —  DUALMX*  RELOAD 
C 

C****  CHECKS  —  DELAY  IN  ARRIVAI  TIME  AT  ATP  OR  ASP  DUE 

C  TO  MTBF  AND  INTERDICTION. 

C 

C***»  CHANGES  —  UNIT  TRUCK  QUEUE 

C  IPARM ( 4 )  NOU  SET  TO  AMMO  MIX  ON  TRUCK  FOR  ASP  ARRIVALS 

C 

INCLUDE  LOG. LIST 
DIMENSION  IPARM(5) 

C 

Cm*  LOCAL  VARIABLES 

Cm*  MIX  —  THE  AMMO  MIX  INDEX 

C*m  DIST  —  DISTANCE  TO  ATP  OR  ASP 

C*m  ITKTYP  —  TRUCK  TYPE 

C****  TVLTIM  —  ROAD  TRAVEL  TIME 

C*m  IASPFG  —  LOCAL  FLAG  =  1  IF  GOING  TO  ASP 

C  =  2  IF  GOING  TO  ATP 

C****  TOTIM  —  TIME  OF  ARRIVAL  AT  ATP  OR  ASF' 

C*m  RNEED  —  REAL  NEED  PER  AMMO  TYPE 

C*m  PERSV  —  USED( WITH  RNEED)  TO  FIND  WORST  NEEDED  TYPE 
C****  JTYP  —  UNIT  TYPE 
C 

NUNIT  =  IPARM ( 1 ) 

NUMTK  =  IPARMC2) 

C 

C  FIND  THE  UNIT  TYPE 

JTYP  *  IUNIT ( NUNIT . 1 ) 

C****  DETERMINE  AMMO  MIX  INDEX 
MIX  =  ITRUCK(NUMTK.  5) 

IF (MIX  .EG.  10  .OR.  MTX  . EG.  40 ) THEN 
NUMAM  =  10 
GO  TO  28 
END  IF 


IF < IMIX ( MIX » I )  .GT.  0 ) THEN 
NUMAM  =  I 
GO  TO  6 
END  IF  ■ 

3  CONTINUE 
i  PERSU  =  10000.0 
DO  10  KK*l»LPPAR<6) 

THIS  LOOP  FIGURES  NEED  FOR  AIL  AMMO  TYPES 
SEND  TRK  AFTER  TYPE  NEEDED  WORST 
h  *  13  *  KK  -  5 

FIND  SMALLEST  PERCENT  OF  AMMO  AVAILABLE  AND  STORE  IT 
IF( IUNIT (NUNIT »K)  .EG.  0>GQ  TO  10 


A  =  IUNIT  < NUNIT  *K  +  4) 

B  =  IUNIT  (NUNIT ..  K  +  l ) 

C  =  IUNIT (NUNIT  *  K+7 ) 

D  =  IUNIT (NUNIT  tK  +  8) 

E  =  IUNIT  (NUNIT  »K+12.» 

IF( B  .EG.  0  .OR.  C  .EG.  0)GC  TO  10 
C  *  *  TO  COMPENSATE  FOR  TWO  SYSTEMS  USING  TOW’. 

Z  =  1 

IF(  IUNIKNUNIT »K)  .£Q.  2)Z  =  0.5 
RNEED  =  (A  +  Z*D  +  Z*E>/(B  *  C) 

I F ( RNEED  ,LT ,  PERSV ) THEN 
PERSV  =  RNEED 
NUMAM  =  IUNIT (NUNIT  f K) 

END  IF 

10  CONTINUE 

IF( ITRUCK(NUMTK> 1 )  .EG.  1 ) THEN 
JLOW  =  1 
JHIGH  =  30 
ELSE 

JLOU  =  31 
JHIGH  *  60 
END  IF 

DO  15  I  *  JLQW> JHIGH 

IF( INIX ( I » NUMAM )  .GT.  0 ) THEN 
MIX  =  I 
GO  TO  20 
END  IF 
15  CONTINUE 

20  ITRUCK(NUMTK»5)  =  MIX 
c  *****  ADD  THE  ROUNDS  DUE  IN  TO  THE  UNIT 
28  DO  25  I  =  1 >LPPAR ( 6 ) 

N  =  I  *  13  -  5 

IF< IUNIT (NUNIT »K)  .EG.  0 ) GO  TO  25 
IUNIT ( NUNIT  *  K  + 1 2 )  =  IUNIT(NUNIT» K  +  12)  +  I 
25  CONTINUE 

C****  IF  MIX  CONTAINS  AMMO  OTHER  THAN  THAT  AT  A 


3  CURR  SUPP 
3  UPNS  ALU 
3  SAL 
3  ON  TRKS 
3  GN  THE  LAY 


3  GET  WORST  NEEDED  T'‘ 


IMIX(MIX»I!INIT<  NUNIT » fc 


'P  (1-10)  GO  TO  ASP 


IF( NUMAM  .GT.  10  .OR.  IUNIT ( NUNIT . 2 )  .FQ.  COGO  TC  35 


C***:t  TRUCK  BOUND  FOR  ATP.  LOOK  UP  DISTANCE  TO  ATP 
DIST  =  IUNIT ( NUNIT >  4) 

IASPF3  =  2 


(DIST  ' 


o  o 


Cm*  TRUCK  BOUND  FOR  ASP .  LOOK  UP  DISTANCE  TO  ASP  'BIS 
35  DIST  =  IUNIT  (NUNIT,  5) 

IASPFG  =  1 

****  DETERMINE  TRUCK  TYPE  ( ITKTYP ) 

40  ITKTYP  =  ITRUCK ( NUMTK »  1) 

C 

C****  DETERMINE  ROAD  TRAVEL  TIME 

TVLTIM  =  60.  *  DIST  /  ITYPE ( ITKTYP , I DAY  41 ) 

C ****  UPDATE  TRUCK  STATUS  CODE 
ITRUCK ( NUMTK  , 3  5  =  4 

cm*  COMPUTE  DELAY  DUE  TO  INTERDICTION  (TMIND) 

CALL  INTRBK  (NUMTK..  TMIND) 

IF ( TMIND  . 3T.0)  THEN 

IF ( IASPFG  .EG.  1 ) JUNIT ( JTYP » 6 )* JUNIT  <  JTYP , s )  +  1 
IF  ( IASPFG  .EG.  2 )  JUNIT  ( JTYP  ,2  '•  = JUNIT  ( JTYP, 2) +i 
ITRUCK (NUMTK, 6.  =  0 
I?ARM(3)  =  IUNIT (NUNIT ,3 ; 

IPARM <  4 )  =  MIX 

CALL  SCHED(5» IPARM, TTME+TMIND) 

RETURN 
END  IF 
C 

Cm*  COMPUTE  DELAY  DUE  TO  FAILURE  (TFAIL) 

CALL  OPERA  (NUMTK,  TVLTIM,  TFAIL) 

C**#*  COMPUTE  TIME  OF  ARRIVAL 

TOTIM  =  TIME  4  TMIND  4  TFAIL  +  TVLTIM 
IF ( IASPFG  .EG.  2)G0  TO  49 
C 

C*m  SCHEDULE  ASP  ARRIVAL. 

IPARM(3)  =  IUNIT ( NUNIT , 3 ) 

IPARM( 4)  =  MIX 

C  ADD  ONE  TO  THE  NUMBER  OF  TRUCKS  TRAVELING  TO  THE  AS 
JUNIT (JTYP, 5)  =  JUNIT: JTYP, 5>  4  1 
C  .  ADD  TO  TRUCKS  KILLED  OR  FAILED 

IF( TFAIL  .GT.  0)  JUNIT ( JTYP. 7)  =  JUNIT ( JTYP, 7)  +  1 
C  ADD  THE  TRAVEL  TIME  TO  THE  ACCUMULATIVE  TRAVEL  TIME 
JUNIT (JTYP, 3)  =  JUNIT (JTYP, 3)  4  TVLTIM 
CALL  SCHED  (5,  IPARM,  TOTIM)  i?  A3PARV 

GO  TO  50 
C 

C*m  SCHEDULE  AT?  ARRIVAL. 

49  IP ARM ( 3 )  =  IUNIT< NUNIT , 2 ) 

IPARM( 4)  =  MIX 

C  ADD  ONE  TO  THE  NUMBER  OF  TRUCKS  TRAVELING  TO  THE  AT 
JUNIT (JTYP, 1 )  =  JUNIT ( JTYP , 1 >  4  1 
IF ( TFAIL  .GT.  0)  JUNIT ( JTYP, 3)  -  JUNIT (JTYP, 3)  4  1 
JUNIT ( JTYP , 4 )  =  JUNIT ( JTYP, 4)  4  TVLTIM 
CALL  SCHED  (4,  IPARM,  TOTIM)  9  ATPARV 

C 

50  RETURN 


o  o  o  o  o  o  o  o  o 


yy.  SUBROUTINE  GETQNE 

SUBROUTINE  GFT0NE( NO*  NUMTK »  I  FLAG) 

C 

GETONE  GETS  A  GIVEN  TRUCK  ' NUMTK '  OUT  OF  QUEUE  NO. 

IF  IT  TS  NOT  IN  THAT  QUEUE*  IFLAG  UTLL  RETURN  rtON-ZFRO. 

CALLED  BY  TRKF'RT  ( IN  THE  EDIT  PROGRAM ) . 

R.  CUNNINGHAM  MAY  S3 

INCLUDE  QUEPNT  *  LIST 
INCLUDE  QUENUM.LIST 
NEXT  =  IHEAD(NQ) 

IFLAG  =  1 

IF (NEXT  .EO.  0)  RETURN 
IF ( NEXT  ,EQ,  NUMTK ) THEN 
IHFAD(NQ)  =  ITEMS( NEXT ) 

ITEMS(NEXT)  =  0 
IFLAG  =  0 
RETURN 
END  IF 


100  CONTINUE 
C 

IF ( NEXT  ,NE.  NUMTK)  THEN 
LAST  =  NEXT 
NEXT  =  ITEIjS  ( LAST ) 

IF ( NEXT  .EG).  0)  RETURN  0  NOT  IN  C1UE 

GO  TO  100 
ELSE 

C  FOUND'! 

ITEMS(LAST)  =  ITEMS ( NEXT ) 

ITEMS<  NEXT )  =  0 
IFLAG  =  0 
END  IF 
RETURN 
END 


r>  ra  o  o 


2.  Edit  Program 


PROGRAM  EDIT 

(MAIN  PROGRAM  FOR  EDITING  BETWEEN  CIs) 

CALLS  EDI  TD  »  GFTGUE.  PRINT.  P'JTQUE.  TRKFUT 
CHARACTER*10  AUNIT 
INCLUDE  LOG. LIST 
INCLUDE  0UENUM.LIS7 
INCLUDE  QIJEPNT .LIST 
INCLUDE  AUNIT, LIST 
DIMENSION  IVALM) 

CHARACTERS  IANS 
DEFINE  FILE  l3< 75» 4.U .  IT7.  :■ 

READ<3)  I ATP » I ASP • I UN  I T , I  TRUCK , I  TYPE , IMIX  » 

$  INTER, IRSTME, IATPSD « IDAY , TIME, I ATPAM, IC3A • 

5  LPPAR » IASPAM  »LU0UT»  TCI8T ,  TCILNfi*  L0!i!< »  IHFaD.  ITEMS . 
i  AUNIT  ,  JUNIT ,  JATP  ,  JASP  , I ATPRF  .  IASPSP  « I  AML'.'L  •  1 3? RV 
DO  100  1=1,75 

READ (13' I) (IVAL(J) , J=l»4> 

I  UNIT ( 1 ,2)=IVAL( 1 ) 

IUNIT ( 1 » 3)  =  IVAL( 2  > 

IUNIT(I,4)=IVAL<3> 

IUNIT ( 1 , 5) =IVAL ( 4  ) 

100  CONTINUE 

PRINT*,'  ZERO  COUNTERS7  (  YES  OR  Nd  )  ' 

READ<5,S0) IANS 

IF ( IANS  .EQ.  'N  '  .OR.  IANS  .EQ.  'NO  ')G0  TO  300 
TCIST  =  INT (TIME) 

INTER ( 1 )  =  0 
INTER(2>  =  0 
DO  200  I  =  1.10 
ISERU(I)  =  0 

IATP (1,16)  =0  8  SERVER  WITHHOLD  COUNTER 

IASP(I,16>  =0  8  SERVER  WITHHOLD  COUNTER 

200  CONTINUE 

300  PRINT*,  '  MODIFY  INTER.  IDAY,  TCTLNG ,  ASP  STATUS...' 

10  URITE<6,20) 

15  FORMAT ( '  (l)-EDIT  DATA  FILES',/, 

%  '  ( 2 i -UPDATE  FA  CURRENT  SUPPLY  (TO  100  PER  CENT > ' , / . 

*  '  (3)-CL0SE  ATP ' , /  , 

I  '  ( 4 ) -MODIFY  TRK  QUE'./, 

i  '  (5) -PRINT  'RUCK  QUEUES',/, 

*  '  (6) -STOP ' ) 

20  FORMATS  ?7?') 

F:EAD(5,*,ERR=25>  IOPT 
Ir ( IOPT.LT. 1 .OR. IOPT . GT.6)G0  TO  25 
GO  TO  (30, 40, 45*50, 60, 90). IOPT 
25  WRITE'.  6, 15  » 

GO  TO  10 
C 

30  CALL  EDITD 
GO  TO  10 


IF  < IUNIT(K, 1 )  .LT.  4  .Oft.  IUNIT(K.li  .GT,  5-'  30  TO  41 
DO  41  I  =  3,125,13 
I UN I T ( K » 1  +  2)  =  0 
IUNIT (K» 1+3)  =  0 

IUNIT ( K  > 1  +  4 )  =  IUNTT <K  7 1  +  1  >  *  IUNTTiK. 1+7) 

41  CONTINUE 
GO  TO  10 
C 

C  ****  THIS  CODE  MOVES .  (CFA)  ATP  Si PS  AND  AMMO  **** 

45  PRINT  *» '  ENTER  ( CFA )  ATP  NUMBER  TO  BE  CLOSED ' 

READ  ( 5  *  * )  NATp 
NATPQ  =  75  +  NATP 

47  CALL  GETQUE ( NUMSP ,NATPQ ) 

IF  ( NUMSP  ,EQ.  0)  GO  TO  10 
PERCNT  =  I TRUCK! NUMSP »6> 

IF  (PERCNT  .LE.  0.)  THEN 

CALL  PUTQUE (NUMSP, 176) 

GO  TO  47 
END  IF 

MIX  =  ITRUCK(NUMSP»5> 

NUMAM  =  MIX  -  LF'PAR ( 3 ) 

IAMCOD  =  NUMAM  *3+13 
IF (MIX  .EQ.  90 ) IAMCOD  =  51  3  FU7ES 

LEAST  =  999999 
DO  48  J  =1,3 

C  AMAV  =  ONHAND  -  DEMAND  +  ON-THF-aiAY 

AMAV  =  IATF'(J, IAMCOD)  -  I  ATP  ( J ,  I AMCUD  +  1)  +  IATPU,  IAMCOD  + 
IF  (AMAV  ,GE.  LEAST)  GO  TO  48 
LEAST  =  AMAV 
LATP  =  J 

48  CONTINUE 

NUMRDS  =  IMIX(MIX» NUMAM)  *  PERCNT  /  10000 
IATP(NATP, IAMCOD)  =  I ATP ( NATP , IAMCOD >  -  NUMRDS 
IATP(LATP, IAMCOD)  =  I  ATP ( LATP , I  .MCQD >  +  NUMRDS 
CALL  PUTQUE (NUMSP, LATP  +  75) 

GO  TO  47 
r 

W 

50  CALL  TRKF'UT 
GO  TO  10 
C 

60  CALL  PRINT 
GO  TO  10 
C 

90  FORMAT (A3  ) 

C 

90  URITE( 4)  I ATP , I ASP » IUNIT, I  TRUCK » I  TYPE , IMIX , INTER  • 

*  IRSTME, IATPSD, ID AY ,TIME , IATPAM, ICSA,LPPAR , IASPAM *LUOUT , 
i  TCIST , TCILNG , LOOK , IHFAB» ITEMS, AUNIT, JUN IT, JAl PriASP, 

*  IATPSP, IASPSP, IAMLVL, ISERV 

PRINT*, '  SSG  ARMPL.DP  UILL  SYM  THIS  REPORT' 

STOP 

END 
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SUBROUTINE  PRINT 
SUBROUTINE  PRINT 

C****  PRINTS  OUT  THE  CONTENTS  OF  EVERY  TRUCK  OH 

C  CALLED  BY  EDIT 

C  CALLS  GETQUE.  PUTQU£>  NXTQUE 

C 

C**»*  D.  HILLIS  APR  7? 

C 

include  auenum* 1 ist 
include  oue^nt* list, 

DIMENSION  NTRK (200) 

DO  70  1=1 » 176 

CALL  NXTQUE ( IFIRST . I ) 

IF ( IFIRST . EQ . 0 '  30  10  50 
DO  10  J* 1.200 

CALL  GETQUE  ( NTS  K-'J).  I) 

CALL  PUTQUE ( NTRK <  J  >  » I  > 

CALL  NXTQUE ( INEXT  •  I ) 

IF ( I  NEXT .EQ . IFIRST )  00  TQ  20 
10  CONTINUE 

C 

20  WRITE (2 >30)  I 

30  F0RMAT(/>5X> 'QUEUE  '>I3>'  TRUCKS') 

WRITE(2>40)  ( NTRK ( K ) *K  =  1 . J  > 

40  FORMAT ( 10( 1X>  14  ) ) 

GO  TO  70 

50  WRITE(2>30 )  I 

URITE(2>60) 

60  FORMAT (5X> 'NONE' ) 

70  CONTINUE 
C 

RETURN 

END 


o  o  o 


3.  Convert  Program 


4.  ADOEVT  Program 


a 

i 


PROGRAM  ADDEVT 
C 

C  THIS  PROGRAM  ALLOWS  ENTR i  OF  EVENTS  FOR  ARM 
C  INTERACTIVELY  SEPARATE  FROM  THE  MATH  PROGRAM. 

C  THESE  EVENTS  ARE  THEN  STORED  IN  A  FILE  1?  CALLED 

C  TEVEHTSCI — .  THIS  IS  A  SOURCE  FILE  WHICH  CAM 

C  THEN  EE  TAKEN  INTO  CTS  EDITOR  AND  CORRECTIONS  MADE. 

C 

C******************x*:t**  ***********:**********.**  ******* 

C 

C  VARIABLES  USED: 

C  I  TYPE . THE  NUMBER  OF  THE  EVFNT 

C  IPARM1 » IPARM2*  IPARM3 » IPAR'M*1 » IP  ARMS 

C  ....THE  ASSOCIATED  PARAMETERS  OF  THE  EVE? 

C 

C  FILES  used:  12  THE  SOURCE  FILE  WHICH  7 S  SAILED 

C  WHEN  ALL  EVENTS  ARE  ENTER'D  FRO.-  KEYBOARD* 

C 

C 

DIMENSION  HYPE ( 500 ) , IPARM1 (500 ) , I PAR M2 < 500 ) . I PAR m3 < TOO ) 

DIMENSION  IPARM4  <  500 ) r I FARMS ( 500 / >  37 1  ME ( 500 < 

CHARACTERS  IANSW 
C 

DO  100  1  =  1 ,  500 
ITYPE ( I ) =0 
IPARM1 ( I ) =0 
IPARM2 ( I >  =0 
IPARM3 ( I )  =0 
IPARM4 ( I ) =0 
IPARM5I I )=0 
STIME( I ) =0 . 

100  CONTINUE 
C 

C  SET  INITIAL  CONTER  TO  1  AND  PROMPT  FOR  EVENTS  TO  EE  ENTERED 

C 

ICOUNT  =  1 

PRINT*. 'ENTER  EVENT  TYFE.PASMS. TIME. SEPARATED  BY  COMMAS' 

PRINT*. 'ENTER  0.0. 0.0.0  TO  COMPLETE  ADDITION  OF  EVENTS' 

2  PRINT*. 

C 

RE  AD* .  ITYF'E  ( ICOUNT) .  IP  ARM  1  ( ICOUNT  ) .  IP  ARM?  ( I  COUNT  )  *  I*' ARMS  (  ICOUNT  >  * 
Z I  PARM4(  ICOUNT) ,  IPAR«5(  ICOUNT  >.  ST IME  ICOUNT) 

IF ( ITYPE ( ICOUNT ) .EQ .0  >50  TO  3 

IF ( I  TYPE ( ICOUNT ) .LT.O  .HR.  ITYPE (ICOUNT). 3T.1?)THEN 
PRINT*. ' INCORRECT  EVENT  TYPE' 

GG  TO  2 
END  IF 

ICGUNT=IC0UNT+1 
30  TO  2 
C 

3  PRINT*,  DO  YOU  WISH  Tfl  SEE  EVENTS - <  OR  N' 

READ (5. 22)  IANSW 
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Information 
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c 

c 

c 
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SUBROUTINE  INFORM 

AMMUNITION  RESUPPLY  MODEL  (ARM) 
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C 
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I***************  aunit  ********************* 

AUNIT (75>  2> 

75  UNITS 

2  ALPHA  FIELDS/UNIT 
COLUMN  1  =  UTH  COORDINATES 
COLUMN  2  =  ALPHA  UNIT  NAMES 


***************  ATP  DATA  ******************* 

IATF'  <  10 » 53 ) 

10  ATP 

53  WORDS  EACH  AS  FOLLOWS i 

1.  DtSTANCE  TO  CSA 

2.  DISTANCE  TO  ASP 

3.  DIS  TO  DAO 

4. 

5.  number  of  arriving  sip  tractors  used  for  return 

of  empty  trailers 

6.  ASSOCIATED  ASF  NUMBER 

7.  QlJE  FOR  ASP  3SP 

3.  NO  OF  MLRS  TRUCKS  BEING  SERVED 

9.  oue  for  csa  sip 

10.  SERVERS  QUEUE  NUMBER 

11.  ARTILLERY  OUEUE  NUMBER 

12.  MANUEVER  UNIT  QUEUE  NUMBER 

13.  CONVOY  COUNTER  AT  CSA ; IF  . GE.  3»  SCHEDULES  CONVOY  FORWAR 

14.  NUMBER  TRUCKS  IN  ARTILLERY  QUEUE 

15.  NUMBER  TRUCK'S  IN  MANUEVER  UNIT  QUEUE 

16.  SERVFR  REMOVAL  KOUNTER 

17.  NUMBER  OF  CONVOYS  SENT  FROM  CSA 

18. 

19. 

20.  NUMBER  OF  TIMES  A  SERVER  NOT  AVAILABLE 

21.  CURRENT  AMMO  SUPPLY.  AMHO  1  <NUMAM*3+18> 

22.  QUEUE  AMMO  DEMAND.  AKMQ  1  <NUMArf*3fl9j 


23.  ON-THE 

-WAY 

(FROM  DAO 

24-26 

AMMO 

•m 

27-29 

an.  mo 

3 

30-32 

ammo 

4 

33-35 

ammo 

r 

W 

36-33 

ammo 

6 

39-41 

ammo 

7 

Cl  Cl  Cl  Cl 


45-47 

43-50 

51 


3iamo  9 
ammo  10 
FUZES 


IATPSB(S)  —  ATP  SERVICE  DATA 

1.  lowest  asp-ats*  round-rob in  number 

2.  ATP  1ST  PRIORITY  S  £  P  OIIFUc 

3.  ATP  2D  PRIORITY  S  1  P  QUEUE 

4.  CFA  ATP  OWNER  NUMBER 

5. 


********  IATPSP  TO  OBTAIN  ASP  '!.  REPLENISHMENT  ******* 


IATPSP< 10*22) 

11  ATP 

1-11  #CSA  S£Ps  ARRIVING  BY  AMMO  TYFE 

12  -  22  #ASP  SSPs  ARRIVING  BY  AMMO  TYPE 


****************  ASP  DATA  ******************** 
IASP  (10.110) 

10  ASP 

110  WORDS  EACH  AS  FOLLOUS: 


1.  DISTANCE  TO  CSA 

2.  ASP  status: 

-1  INACTIVE  0  ACTIVF/NO  CONVOYS  1  ACTIVE/CONVOYS 

3.  CUMULATIVE  HELICOPTER  COUNTER 

4.  QUEUE  FOR  CSA-ASP  S*P  TRUCKS 

5.  NUMBFR  TRUCKS  TO  CSA 

a.  NUMBER  OF  EMPTY  S  1  Ps  AT  ASP 
7.  SERVERS  QUEUE  NUMBER 
3.  NUMBER  MLRS  BEING  SERVED 

9.  ROUTINE  QUEUE  NUMBER 

10.  MLRS  QUEUE  NUMBER 

11.  REAR  ASP  NUMBER 

12.  NUMBER  TRUCKS  IN  ROUTINE  QUEUE 

13.  NUMBER  TRUCKS  IN  MLRS  QUEUE 

14.  CONVOY  COUNTER  AT  CSA  (IF  .GE.  7<  SCHEDULE  CONVOY  FORWARD ) 

15.  HELICOPTER  3ERVFR  COUNTER 

16.  SERVER  REMOVAL  COUNTER 

17.  NUMBER  OF  CONVOYS  SENT  FROM  CSA 

13.  QUEUE  FOR  ASP- AT?  ROUND  ROBIN  3  £  ?  S 
19. 

0.  NUMBER  OF  TIMES  A  SERVER  NOT  AVAILABLE  -CR  UNIT  TRUCK 

1.  CURRENT  AMMO  SUPPLY.  AMMO  1  . NUMAM*3+3 3 > 

2.  QUEUE  AMMO  DFMAND .  AMMO  1  ■. NUM am*3*1  ?  i 

3.  AMMO  ON  THE  WAY  (FROM  C3A  OR  DAO :  ,  A««0  1  •: NI  MAM*3+20  < 


o  o  o  o  o  o  o  o  o  o  o  o  o  o  r-j  o  o  o  o  o  n  n  ri  n  o  o  o  o  o  o  o  o  o  o  r>  o  CJ  o  o  o  o  o  n  o  o  n  ci  o  ri  o 


********  lASF'SP  TO  OBTAIN  *  S  1  P  ARRIVALS  BY  ANNO  TYPE  *?:****:<* 

I A3PSP (10*30) 

10  ASP 

30  AMMO  TYPES 


IATPAM  (10*40) 


AMMO  REMOVED  FROM  ATP 
10  ATP*  10  AMMO  TYPES 


10  10  TON  TRUCKS  SERVICED 
20  5  TON  TRUCKS  SERVICED 

30  10  TON  TRUCKS  BUMPED 
40  5  TON  TRUCKS  BUMPED 


(rfl.RS  U/  TIP; ) 

‘;mi_rs  a/o  tlr  ) 


IASPAMdO*  120) 


AMMO  REMOVED  FROM  ASP 
10  ASP*  30  AMMO  TYPES 


30  10  TON  TRUCKS  SERVICED 
SO  5  TON  TRUCKS  SERVICED 
70  ATP  SIP  SFRVICED 
30  *  CSA-ATP  ARRIVALS 

#  HELI  LOADS  REMOVED 
120  #  CSA-ASP  S  I  PS  ARRIVED 


IAMLVL(2*30) 


STQCKAGE  OBJECTIVES 


1  /  l  -  10  ATP  S  0 
2/1-30  ASP  S  0 
1*29  MAX  ATP  ST0CKAGE  % 
1*30  MAX  ASP  ST0CNAGE  7. 


ISERV(IO)  SERVER  MANIPULATIONS 


1.  ♦  ATP  SERVERS  TO  BE  HELD  (AS  FOR  DISPLACEMENT  -  AIL  ATP 

2.  *  ASP  SERVERS  TO  BE  HELD  (AS  FOR  DISPLACEMENT  -  ALL  ASR 

3.  ATP  SERVER  HOLD  QUEUE 

4.  ASP  SERVER  HOLD  QUEUE 

5.  INTERDICTED  ATP  # 

6.  INTERDICTED  ASP  » 

7.  MINUTES  SERVERS  TO  BE  HELD  IN  HOLD  QUEUE  Al  ATP 


rp  O'* 


I UN IT  (75*142) 

75  UN  T 13 

142  WORDS  EACH  AS  FOLLOWS! 


1. 

2. 

3. 

4. 

5 . 

6 . 
7. 
3. 
9. 

10. 

11. 

12. 

13 . 

14. 

15. 

16. 
17. 
13. 

19. 

20. 
21- 
34- 
47- 
60- 
73- 
96- 
99- 
112 
125 

138 

139 

140 


TYPE 

ATP  NUMBER 
ASP  NUMBER 
DISTANCE  TO  ATP 
DISTANCE  TO  AS? 

TIME  THAT  THE  LAST  TRUCK  FOR  THIS  U 
HELD  MISSIONS  RECEIVED 
FIRST  AMMO  TYPE 
NUMBER  WEAPONS  ALIVE* 

NUMBER  WEAPONS  SHORT  AMMO  , 

NUMBER  ROUNDS  SHORT.  (WPNS) 

CURRENT  AMMO  SUPPLY,  ( UPN3 > 

ROUTINE  RESUPPLY  LEVEL,  (PER  WPN) 
CRITICAL  RESUPPLY  LEVEL,  (PFR  WPN ) 
BASIC  AMMO  LEVEL,  (PER  WPN) 

AMMO  ON  TRUCKS, 

NUMBER  OF  WEAPONS  KILLED  A*  THE  END 
NUMBER  OF  WEAPONS  SHORT  AMMO 
TOTAL  ROUNDS  SHORT  THROUGH  WHOLE  Cl 
STORAGE  FOR  NO.  RDS  RESUPPLY  ENROUTE 
33  , SECOND  AMMO  TYPE 

46  .THIRD  AMMO  TYPE 

59  .FOURTH  AMMO  TYPE 

72  .FIFTH  AMMO  TYPE 

35  .SIXTH  AMMO  TYPE 

98  .SEVENTH  AMMO  TYPE 

111  .EIGHTH  AMMO  TYPE 

-124  .NINTH  AMMO  TYPE 

-137  .TENTH  AMMO  TYPE 

.  NUMBER  OF  HELICOPTERS  ASSIGNED 
.  =  0  IF  SINGLE  PULSE  DEMAND  PER  Cl 

=  1  IF  MULTIPLE  PULSES  PER  Cl 
-142  COUNTFRS 


IT 

WAS 

INTR 

DKED 

F 

1 — « 

CO 

— » 

AMMO 

TYFE 

F 

TRST 

Af*MG 

TYPE 

z 

IS  ST 

AMMO 

TYPE 

c 

IRF.T 

AMttQ 

TYPE 

c 

IRST 

AMMO 

7  !  iZ 

F 

TRST 

AMMO 

TY  F  = 

F 

IRST 

AMMO 

TYPE 

c 

IRST 

AMMO 

TYPE 

OF 

Cl. 

1ST  i 

A ri MO  T 

FIR 

ST  A: 

MnO  TY 

FIRST  AMMO  T Y F 


IR'STME  (23,3) 


RESUPPLY  TIME  DATA 
23  TYPES  OF  AMMO 
3  WORDS  EACH  AS  FOLLOWS 


1.  WEAPON  SET-UP  TIMF 

2.  LOAD  TIME  PER  ROUND 

3.  TRAVEL  TIME  TO  WEAPON 


it-  LiJ  UJ 


I TRUCK  ( 1400* 15 ) 


1400  TRUCKS 

15  WORDS  EACH  AS  FOLLOWS: 


1.  TRUCK  TYPE 

2.  MISSION  TYPE 

3.  STATUS  TYPE 

4.  OWNER  NUMBER 

5.  AMMO  MIX  NUMBER 

6.  PERCENT  LOADED 


//  SERVER  OFF-LOAD  TIME  AT  ASP 
//  SERVER  LOAD  TIME 


7.  TIME  SINCE  LAST  FAILURE 


TRUCK  countess; 


C3A-ATP  CHA-AhP  AHF'-AYP 


♦failures 

♦INTERDICTIONS 
♦ARRIVALS  FROM! 

QUEUE  TIME 


ASP/ATP 
♦RELOADS 
ASP/ ATP 
(*  BUMPED 


D--A 
9  CSA 
CSA 


( TIME  M: 


ASP 

♦ ;  H  S  U  -  ?  U  T  3  AT  ASP 
AS? 

)  K  A I  ASP; 


TO  ,’D  ASP)  ATP/AhP  Q) 


(♦BUMPED 
TO  ASP) 

(*  >3  IN 
MLRS  QUE 


♦  ♦MPTY9ASP  (.<  5HMPP9 
! 0  REAR  ASP) 


SERVER  counters: 


♦FAILURES 

♦S  S  P  OFF-LOADS 

♦ASP-ATP  StP  LOADUPS 

♦  5TQN  LOAD  UPS 

♦  10T0N  LOAD  UPS 

♦  LOAD  UPS  FROM  CSA  S  3 


I  TYPE  (9*6) 


9  TYPES  OF  TRUCKS 

6  WORDS  FUR  EACH  TYPE  TRUCK  AS  FOLLOWS: 


1.  SECONDARY  ROAD  NIGHT  SPEED  (UNIT  TO  ASP* AT? ) 

2.  SECONDARY  ROAD  DAY  SPEED  (UNIT  TO  ASP* ATP; 

3.  HIGHWAY  NIGHT  SPEED 

4.  HIGHWAY  DAY  SPEED 

5.  MTBF 
a.  MTTR 


TRUCK  queues: 


QUEUE  typf: 


AT  EACH  UNIT 

AT  ATPS  FOR  CSA-ATP  S  i  =S 
AT  ATPS  FOR  ASP-Al?  S  i  PS 
AT  ATF'S  FUR  UNIT  AkTILLERY  SERVER 
AT  ATPS  FOR  UNIT  MANUtVER  SERVER 


1-6  -  133 

7 

AT 

ASPS 

FOR  CSA- ASP  S  i  FS 

136  -  145 

3 

AT 

ASPS 

FiiR  ROUTINE  UNIT  i  RUt 

146  -  135 

9 

AT 

ASPS 

FOR  MU'S  UNIT  TRUCKS 

156  -  165 

10 

at 

3SPS 

for  serve -5 

166  -  175 

11 

AT 

ASPS 

FOR  ASP -A !  r  3  I  PR 

176 

12 

AT 

CSA 

“OR  C  S  A  3  i  P  S 

xxxxxxxxxxxxxxxxxxxx  AiifiQ  DATA  xxxxxxxxxxx**xx*xxxxx 

IMIX<91»3?) 

?1  AMMO  MIXES 
1  -  30  10TQN  MIXES 

31  -  AO  5T0N  MIXES 

61-90  S  5  P  MIXES 
91  HELICOPTER  MIX 

32  WORDS  FOR  EACH  MIX  AS  FOLLOW'-:: 

1-30  NUMBER  ROUNDS  OF  EACH  AMMO  TYPE 

31.  LOAD  TIME  AT  CSA/ATP 

32.  LOAD  TIME  AT  ASP 


XXXXXXXXXXXXXXXXXX  MISC  DATA  XXXXXXXXXXXXXXXXXX*** 


EVENT  SCHEDULING 

COMMON/EVENTS/  JSTAT<6>»  JLVDS(2048*4) »  IKVS(5»2048> 


QUEUE  DATA 


COMMON  /QIJENIJM/  IHEAD(17o) 
COMMON  /QUEPNT /  ITEMS  <1400) 


INTERDICTION  DATA  -  COMMON  INTER < 10 ) 

1  COUNTER  FOR  ZONE  1  TRUCKS  KILLED  IN  INTh'DK 

2  COUNTER  FOR  ZNNE  2  TRUCKS  KILLED  IN  INTRDK 

3  NUMBER  OF  TRUCKS  TO  BE  KILLED  i'N  ZONE  ONE 

4  NUMBER  OF  TRUCKS  TO  BE  KILLED  IN  ZONE  2 

5  TIME  TO  REPLACE  TRUCK  TN  ZONE  1 

6  TIME  TO  REPLACE  TRUCK  IN  ZONE  2 

7  MODULO  OF  TRUCKS  TO  HE  KILLED  IN  ZONE  1 

8  MODULO  OF  TRUCKS  TO  BE  KILLED  IN  ZONE  2 


0 


o  n  o  o  o  o  o  o  r>  o  o  n  o  o  o  n  o  o  o  r>  o  o  o 


10  NUMBER  OF  ZONE  TWO  TRUCKS  ENTERING  IN'! SDK 


C 


IDAY  1  =  DAY  »  0  =  NIGHT 

ICSA<3.32)  —  NUMBER  GF  ROUNDS  BY  AMrtO  TYPE  FROM  CSA 


(1.1-11)  #  SiPs  TO  ATP 
<2.1-30)  *  SIPs  TO  ASP 

•3. 1-30 i  CUMULATIVE  AMMO  DFMAND  OF  ALL  UNIT 
1-30  AMMO  TYPES 

2.31  COUNTER  FOR  EMPTY  S  S  Ps  AT  DSA 

3.32  COUNTER  FOR  EMPTY  POL  TRUCKS  AT  CSA 


LPPAR(l) 
LPPAR ( 2 ) 
LPPAR ( 3 ) 
LPPAR ( 4 ) 
LPPAR(S) 
LPPAR(6) 
LPPAR (7) 
LPPAR (8) 


—  TOTAL  NUMBER  OF  AMMO  CODER  (30; 

—  NUMBER  OF  AMMO  CODES  AT  ATP  CO) 

—  NUMBER  OF  MANEUVER  UNIT  AMMO  CODES  AT  ATP<3> 

—  NUMBER  OF  TRANSPORTS ( TRUCKS )  <!.T  1400) 

—  NUMBER  OF  HELICOPTERS  AVAILABLE  (10) 

—  NUMBER  OF  AMMO  TYPES  AT  IJNITSl'LE  10) 

—  NUMBER  TO  SUBT  FROM  5T0N  MIX  TO  GhT  AMMO  TYPE(NUMAM) 

—  NUMBER  TO  SUBT  FROM  S*P  MIX  TO  GET  AMMO  TYPE  <  NIJMAM . 


C 

c 

C  TCIST  —  TIME  OF  START  OF  Cl  IN  DECIMA)  MINUTES 

TCIST  MUST  BE  .0005  FOR  CIO!  '!!!) 

C 

C  TCILNG  —  TIME  OF  LENGTH  OF  Cl  IN  DECIMAL  MiNUTtS 

C 
C 
C 
C 
C 

c 
c 
c 
c 
c 
c 

r 


TIME  —  SIMULATION  TIME  IN  MINUTES  (DECIMAL) 


*Mtt*tt%*t%t%****%*  TYPE  CODE  DATA  **t**xi**x**!lijsS:****x 


UNIT  TYPE  CODES: 


TANK  TASK  FORCE 
MECH  TASK  FORCE 
ARMRD  CAV  SOON 
155  ARTY  BTRY 
S  INCH  ARTY  BTRY 
MLRS  BTRY 
DIVAD  GUN  PLT 
CBT  AVN  PLT 


TRUCK  TYPE  CODES 


c 

c 

f* 

o 

c 


c 

c 

c 

C 

C 

C 

p 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

e 

c 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

r 

w 

C 


1  10  TON 

2  5  TON 

3  5  TON  KITH  1  1/2  TUN  TRAILER 

4  10  TON  WITH  10  TON  TRL. 

5  22  TON  STAKE  i  PLATFORM 

6  HELICOPTER 

7  GOER 

8  ROUGH  TERRAIN  FORKLIFT 

9  CRANE 


AMMO  TYPE  CODES  : 

1  105  MM  (M60-A3/XM1 > 

2  TOW 

3  POWDER  CANISTERS 

4  155  HE 

5  155  ICMDP 

6  3  INCH  HE 

7  8  INCH  ICMDP 

8  8  INCH  POWDER 

9  HELLFIRE 

10  MRLS 

11  155  RAP 

12  155  CLGP 

13  155  SMOKE 

14  30mi»<  AAH ) 

15  8  INCH  RAP 

16  MORTAR 

17  6USHMASTER 

18  BIVAD 

19  SMALL  ARMS 

20  FUZES 


XXXXXXIXXXXX  TYPE  CODE  DATA  (CONTINUED) 
TRUCK  MISSION  TYPE  CODES  J 

1  UNIT  TRUCK 

2  CSA  -  ATP  LINK 

3  CSA  -  ASP  LINK 

4  ASP  -  ATP  LINK 

5  ASP  -  UNIT  ( HELICOPTER ) 

6  ATP  SERVER 

7  ASP  SERVER 


C  TRUCK  STATUS  TYPE  CODES  : 

C 


3-142 


XXXXXXXXXIXXXXXX 


2  IN  ATP  QUEUE 

3  IN  ASP  QUEUE 

4  IN  TRANSIT  --  OR  BUSY  IF  SERVES 

5  UNIT  TRUCK  GOING  FROM  ATP  TO  ASP  —  SERVER  MOVING  fO  NHU  LOCATION 

6  TRUCK  AWAITING  REPAIR 

7  TRUCK  DEAD  (INTERDICTED) 

3  IN  CSA  QUE 

9  BUMPED  TO  2D  ASP  —  SERVER  OK  INTERDICTED  ASK/ATP 
data  for  turnaround  times  3nd  Queue  waits 


**M**S*******i****: *  junit  *t**t%t%tx**tw*x*x**it* 


Junit(8»24) 

for  the  3  types  of  units  the  following 


number  of  trucks  sent  to  the  ate  from  the  unit 
number  of  trucks  killed  on  that  move 
number  failed  on  that  move 

total  travel  time  for  all  trucks  on  that  move 
number  of  trucks  sent  to  the  asp  from  the  unit 
number  of  trucks  killed  on  that  move 
number  failed  on  that  move 

total  travel  time  for  all  trucks  on  that  move 
number  of  trucks  sent  to  the  asp  from  the  atp 
number  killed  on  that  move 
number  failed  on  that  move 

total  travel  time  for  all  trucks  on  that  move 
number  of  trucks  sent,  to  the  unit  from  the  atp 
number  killed  <>n  that  move 
number  failed  on  that  move 

total  travel  time  for  all  trucks  on  that  wove 
number  of  trucks  sent  to  the  unit  from  the  ssp 
number  failed  on  that  move 

total  travel  time  for  all  trucks  on  that  move 
total  time  spent  in  reloading  weapons 
total  time  available  for  unit  trucks 
number  of  trucks  killed  during  reined 


XM#****:*:*  ***********  jatp  *:*******i*:*************** 
J3tp< 10»6> 

for  the  10  different  atps  the  following: 

1.  number  of  trucks  served  by  the  manuver  Queue 

2.  total  Queue  wait  time  for  all  trucks  served 

3.  maximum  wait  time  for  the  manuver  Queue 

4.  trucks  served  through  the  artillery  Queue 


r i  ro 


6.  maximum  wait  time  for  the  artillery  aueue 


******  ***************  jasp  ************************* 


j3Sp( 10*9) 

for  the  10  different  asps  the  following! 

1.  trucks  served  through  the  routine  aueue 
.  total  wait  time  for  all  trucks  served 
.  maximum  wait  time  in  the  routine  aueue 

4.  trucks  served  through  tne  airs  Queue 

5.  total  wait  time  for  all  trucks  served 

6.  maximum  wait  time  in  the  mlrs  Queue 

7.  trucks  served  through  the  ASF-4  TP  aueue 
3.  total  wait  time  for  all  trucks  served 
9.  maximum  wait  time  in  the  ASP-ATP  aueue 


o  no  o  u  n  n  o  n  o  o  o  o  rj  n  o  o  o  n  o  o  o  a  o  o  o  o  o  o  o  n  cd  n  o  n  c~j  o  o  cj  o  o  o  n 


Demand  Generation  Program 


#**  RANMOD  *** 

RANMOD  creates  and  edits  ammunition  demand  flies  for  toe 
ARM  model  3nd  generates  new  demand.  Files  are  assigned 
in  an  SSfi  runstream  -i S ? J f* 3 i  *  RANMOD  can  run  independently * 
but  only  temporary  files  are  created  and  data  is  not  stored 
**:**:«***#  *  :*:**:*  *  t  .*  *  *  :»*  Ju  :< 

DA i A  SECTION 

I*#******:*:*:**'***: *i  :*:<*:*:»* 

IN1;  holds  the  input  values'. 

I NV I  no  change*  M(jRP*100*  intensity*  ena-s*** 

rets  mb;:*  change »  method?  1st  unit* 

last  unit*  cur  unit*  1st  copy*  ivsf  cop*:. 

file  trtmnt *  ammo  code*  no.  of  Cl's 
IUPV  holds  values  which  change  for  each  wen  m  *.he  un  i  •. . 
IUPV:  wen  sys  code*  max  e;;p  limit*  min  exp  limit* 

initial  draw*  Phase  draw*  exe  rale  dif*'< 

IMD  holds  the  status  for  options  available  < CHMQS '? 

<l=do  change*  0=don't  change). 

IND;  alive*  short*  wen  type*  ah's*  mnt  ret*  war  r«s* 

inst  dmd*  copy*  print*  save*  demand*  by  3mmc  code* 
IAMAT  holds  the  attributes  tor  the  specified  unit  m 
the  specified  CIs.  It  is  the  window  for  the  files. 

I  Art A  T  t  ammo  code*  wens  alive*  wens  short*  ahs*  demand 
KRQW  and  KCOL  =  row  and  col  indices  for  IAMAT. 

IANS  used  primarily  for  user  responses. 

LEAP  holds  the  offset  for  the  INFO  subroutine. 

MNT  and  KMBJ  mnt  rets  &  war  reserves*  RETS:  total  rets 
URN  holds  the  name  of  each  weapon  in  the  unit. 

AMON  holds  the  name  of  any  new  ammo  type. 

RNBS*.  rounds/tube*  RNDT5  tot  mds  <RN0$*wens  snort*. 

DRAW  and  CNN  =  intermediate  steps  for  RN£iT 

NQCI  holds  the  Cl  number  i'l-55)  o'  each  Cl  involved. 

DRN  holds  the  phase  categories  (day*  night*. 

DIMENSION  I  An  AT  ( 30 » 3 )  *  NGC I  ( 3 )  *  RNOS  v  6  *  3 )  >  I N  D  \  1)? )  *  K  MB  •; » "j  *  *  Mr) 
DIMENSION  I F I L ( 3 >  *  AMON ( » ) .  I NY <  ■  5 ) » ? UP1.1  •:  a  * 6 )  * RnDt  <  3 )  •  BkN  *  2  V 
DIMENSION  KWPSfS  ( 14)  *  URS  f  S 14)  *  MAX  AS  <  1 3  *  7 )  *  M I >JAR  13*7  *  L  N 
DIMENSION  KHU  <  6 ) *  MAXY i 12) *  CHNGS  < 12 ) *PER i S ) *  LOAD < 1 4  ■  *IH0UL 

CHARACTERS  UNAME 
CHARACTER *10  UPSYS*CHNGS*AMi)N»wPN 
CHARACTER*?  DRN 

MAXV  holds  upper  limits  for  testable  variables: 

MAXY5  Cl  no.*  M0PR*100*  intensity*  phase* 

ret  opts*  operation*  method*  unit,  no.* 

wpn  sys*  status*  file  sice*  no  nf  Cl; 

DATA  MAX V  /  5  5  *  1 00*8*2*4*5*3*  5*14* 12*30 *3/ 

MAXAR  and  MINAR  hold  ammo  expenditure  limits  for  t n?  1 
standard  wpn  types  included  in  the  data  bs*e. 


DATA  « 

( h  AX  A  R i  I ,  J ) 

L.. 

II 

►— » 

.7) ,  I 

=  1,13 

) 

Z/ 

93. 

60 » 

w  w  9 

5o , 

30, 

37, 

0 , 

A 

400 . 

240, 

360, 

0 , 

0, 

0 , 

0 , 

B 

1200. 

720, 

1100, 

0  • 

0 , 

0, 

0, 

C 

20. 

12, 

3, 

15, 

5 , 

20, 

0 , 

D 

12. 

3. 

10. 

3 , 

4, 

12, 

0, 

z. 

420. 

295, 

135, 

232, 

34, 

350, 

0, 

P 

750. 

430, 

200, 

480  , 

200 , 

300, 

0, 

6 

380. 

261, 

186 , 

0, 

o. 

380 , 

0, 

H 

550. 

375. 

250, 

0, 

0, 

550, 

0, 

T 

210. 

145, 

100, 

0, 

0, 

210, 

0 , 

J 

720. 

458, 

300, 

o. 

o, 

630 , 

0, 

K 

16. 

16, 

1  o , 

16, 

16 » 

16 » 

1 6 , 

L 

500. 

500, 

500 . 

5o0 , 

500 « 

500. 

500/ 

DATA  < ( MINAfi ( I ,  J ) 

,  J=1 

,  7  i ,  I 

=  1.13 

) 

1/ 

35. 

24, 

10, 

15, 

5. 

30. 

o. 

A 

200. 

120, 

180, 

0, 

0, 

o. 

0, 

B 

700. 

420. 

o50 , 

o. 

o. 

0, 

0, 

C 

9. 

5 , 

4, 

3  * 

1, 

8, 

0, 

D 

5 . 

2, 

2, 

2, 

1 , 

5 , 

o. 

c 

240. 

135, 

80, 

92, 

24, 

190, 

0, 

z 

550, 

300, 

60 , 

300, 

60 , 

100, 

0, 

G 

300 , 

181, 

86 , 

0, 

0, 

300. 

0 , 

H 

450, 

275, 

150. 

o. 

o. 

450, 

o. 

T 

75, 

35, 

50, 

o, 

0, 

ISO, 

0, 

J 

540, 

298, 

180, 

0, 

0, 

450, 

0, 

K 

12, 

12, 

12, 

12, 

12, 

12, 

12, 

L 

400, 

400, 

400, 

400, 

400, 

400, 

400/ 

Unit  names 


DATA  UNArtE/ 

'TF1A 

' , ' TF2A 

' .  '  TF3A 

' , ' Tc  4A 

/ 

T9  5A 

a ' TF6A 

/ 

'  TF7A 

• , ' TF3A 

'  , ' TF1M 

'  , '  T  F  ,A 

'  , 

TF2h 

b ' TF4M 

! 

'  TF5M 

' , 'TF6M 

' , ' 12ACR 

' .  13A0R 

'  • 

FA120f 

c ' FA13ACR 

/ 

' A11FA 

' ,  '  B 1 1 F  A 

' ,  'CliFA 

> '  Ai:-:"A 

/ 

B12FA 

d ' C12FA 

/ 

' A13FA 

' ,  '  3 1 3  F  A 

' , '  C13FA 

'  ,  AI-.FA 

/ , 

Bi  4FA 

e ' C14FA 

/ 

'  A15FA 

'  ,'BISFA 

' , ' C15F A 

'■  AloFA 

'■  f 

Bl  6rA 

f ' C16FA 

'  f 

' A17FA 

' , ' B17FA 

' , 'Cl7FA 

'  ,  A 1 3  F  A 

t 

51  Sr*  A 

3'C13FA 

/ 

' A19FA 

' , ' B19FA 

' » 'C19FA 

' , ' A20FA 

' , 

8  2  0  F  A 

h ' C20FA 

/ 

' A21FA 

' , ' B21FA 

' » ' C21FA 

■ .  A22FA 

f 

B22FA 

l ' C22FA 

'  f 

' A23FA 

'  ,  •'  B23FA 

' , 'C23FA 

' . ' A24FA 

f 

B  4  F  A 

j ' C24FA 

r 

' A25FA 

' , '  S25FA 

f  '  C  2  5  •“  h 

>  A  2  5  F  A 

» 

3  2  6  F  A 

k  '  C  2  6  F  A 

t 

'  A1  ADA 

' ,  ■ B1ADA 

' ?  ' Cl  ADA 

' . '  i;a.'a 

1 3  «  DA 

1' 1ACAS 

/ 

' 2ACAS 

' , '  3ACAS 

/  / 

? 

' 

Weapon  system  names 

DATA  WPSYS/  '  10SMM  TANK  '  » '50CAL  TANK'.'?.  62  .NQ  '  »  CPU  TOW 
2'IFV  TOW  MORTAR  ' » '3USHMASTFR'  ,  3- T  N  HfiU  ' . '  1~5  «OW 

A'HLRS  '» 'OIVAB  ' , ' HELLF IRE  ' . ' 20rtrt  ATK  H'.' OTHER 

KWPSYS  holds  ammo  codes  for  each  wpn  type!  r.HU  ho'ds 
ammo  codes  for  howitzers.  They  =  IAnAT,  col  i. 
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DATA  KiiPSYS/  1 » 23  ?  24 »  2 »  23 » 16 » 17 


,  4»  10*  1-3*  ?» 14,99 / 


Names  of  available  options.  Values  neld  in  I N D  array. 

DATA  CHNGS/  'WPNS  ALIVE' »  'URNS  SHORT'  >  '»PM  TYPE  '  .'ATS  Hr  LIS 

Z  'MAINT  RET  ' . ' COMBAT  RSV'.'INS  DEMAND' , 'COPY  UNIT 

Z  'AUTO  LIST  '.’AUTO  SAVE  ’  » '  NE’ni  DEMAND'.'?'  AMMO  Nil 


DATA  (INV(I). 1  =  1. 15)/0. 100. 1.1.11*0/.  MNT ? KMB/36*0/ 

I F I L  holds  base  no  fop  input  and  output  units  i files) 

IFIL5  binary  read,  binary  write*  report  file 
DATA  UPN.AMON/12*'  '/.  IFIL.'S *  1 1 . 1  4/ 

DATA  IND  /l2*0/»  IUFV/3o*0/,  RNDS/13*0.0/.  RNBT/3*0.0/ 

Basic  load  factors  for  wpn  systems,  used  fo"  calcuiatins 
demand  increases  due  to  ant  returns  and  combat  reserve-'. 
DATA  LOAD/ 1»0»0. 12*6.115.3^0.0.0. 12.1 078. 16.1200*0/ 

DATA  IHQUL/21. 83* 14. 5. 5.3. 3 0.6*2. 2.10*34.6 / 

PER  holds  percentages  for  howitzer  ammo  types. 

DATA  PER/0. 16 .0 .65*0 . 1 1 .0.04 ,0 .04 .0.20 .0 .68* 0. 12/ 

DATA  IAMAT/?0*0/»  NOCI/3*'  '/»  URN/'  DAY  '.'NIGHT'/ 

DATA  IANS. LEAP/2*0/ »  KR0U,KC0L/2*1/ .  F:ETS*DRAU,CUM/3*0.0/ 

*******.******x**********x************xxx* 

******  MAIN  PROGRAM  ****** 
**************************************:*** 

Determine  how  the  files  will  be  handled. 

LEAP=S 

PRINT*.  '  ENTER  FILE  TREATMENT.  <INP0*0>' 

WRITE ( 6. 1001 > 

FORMAT (/.IX. ' l.  NEW  FILES  FROM  OLD.  2.  NFL  FILES.  ’ 

'FROM  SCRATCH.  3.  COPY  SECTIONS.  • 

READ*.  INV! 13) 

IF ! INV ( 13 ) . EQ . 0 ) CALL  INFO ( LFAP *  x 1000 ) 

CALL  VERIFY!INV(13), 3**1000) 

********** 

Enter  the  no.  «f  CIs.  93ch  Cl  no.  and  verify.  Cl  ms 
are  for  listings  only.  There  is  no  affect  on  files. 

LEAP=6 

PRINT*.  '  ENTER  THE  NO.  OF  CIS  AND  EACH  Cl  NO.  <INF0*0»0)' 
READ*.  INV! 15)  >  < NOCI ( I ) . 1  =  1 • INV( 15) > 

IF(INV(15) .EQ.0)CALL  INFO (LEAP, *30 » 

CALL  VERIFY ( INV  ( 15) , MAXV ( 12) * *30 ) 

I ANS=0 

DO  3?  1=1, INV( 15) 

I F  ( N  0  C I  ( I ) .  L  T .  1 . 0  R .  N  0  C I  ( I ) .  G  T .  M  A  X  V  •  1 ) )  I A  N  S = - 1 
CONTINUE 

CALL  VERIFY! IANS, 0. *30) 

********** 
open  the  files 
DO  32  I  =  1 , INV! 15) 

OPEN(UNIT«!IFIL!l)  +  I). ACCESS*' DIR' ,RCD$*MAXV<  3 • ,RECL*MAYV( 1 
A330C=NRED) 

OPEN! UNIT* !  IFIL(2)  +1 » .ACCESS- ' DIR '  , RCDS “MAX V ! 3  » •  REOl*MA/V •:  1 


o 


an 

CONTINUE 

C 

********** 

IFUNV ( 13) . EG .  2  >  THEN 

CALL  NUFILE 

CALL  UNTNOS 

ELSE 

IF( INV( 13) .EG. 1 ) CALL 

COPFIL  3Copy 

read  files 

CALL  METHUD 

GEstsol  i 

sh  method 

CALL  UNTNOS 

^obtain 

unit  nos. 

ENDIF 

c 

********** 

60 

CALL  BRANCH 

2b ranch  to  cho 

sen  method 

90 

C 

LEAP=NXTSTP( dummy) 

^determine  ne^-- 

t  step 

GOTO (92, 93, 94, 95, 96, 97) LEAP 

93 

CALL  METHUD 

2chanae  methoc 

3 

92 

CALL  UNTNOS 

0neu  unit  nos, 

same  method 

GOTO  60 

L 

94 

r 

CALL  COFYUN ( *90 ) 

2copy  seauence 

of  units 

L 

?5 

r 

CALL  NUCICUOOO) 

0new  run 

L, 

96 

p 

CALL  PRNTFL ( *90 )  2p 

rint  file  (DPFO 

or  screen) 

L 

97 

DO  98  1=1 , INV ( 15 ) 

CLOSE ( UNIT  = ( I F I L  < 1 )  + 1 > ) 
CLOSE <UNIT=( IFIL<2)+I>) 

9e 

CONTINUE 

PRINT*,  '  PROGRAM  IS  FINISHED.'  3fteo 


C 

C 

C 

C 

C 

c 

c 

100 


u 


C 


STOP 


xt£xxxxxxx»*xxxxxxxxxxx%xxxx:«xx*xx.t**tis 


*****  SUBROUTINE  SECTION  ***** 
**************************************** 
SUBROUTINE  METHOD 

Set  counter  (LEAP)  for  use  with  INFO  routine. 
Obtain  type  of  operation  and  netted  to  ne  used. 


Test 

LEAP=1 

PRINT*, 

PRINT*, 

PRINT*, 

PRINT*, 

PRINT*, 

PRINT*, 

PRINT*, 


reponses  for  validity. 

'  ENTER  OPERATION  AND  MrTHOD. 
'  TYPE  OF  OPERATION:  MET 


1  =  EDIT /'NEU  DEMAND  1  = 

2  =  COPY  SEGIJFNCES  2  = 

3  =  PRINT  FILES  3  = 

4  =  CHANGE  BY  ROW'  . 

5  =  CREATE  NEU  FILES'  @As 
READ*,  INV(6),  INV l 7) 

IF ( INV<  6  > . EG. 0 . OR . IN'A  7) . EG . 0 ’CALL 
CALL  VERIFY ( INV ( 6 ) ,  MAXV  (  6  '• ,  *100 ) 
CALL  VERIFY  ( INV(  7 )  *MA-XV(7) ,  *100  • 


(INF 
HOD  T 
UNIT 
HNIT 
UNIT 

siane 

INFO 


0=0,0 
0  BE 
S  IN 
5  AT 
S  BY 


> 

used:  ' 

SFHUENC 
= 4ND0M  ' 
GROUP' 


d  m  NUFTLE 
(LEAP, *100  - 


RETURN 

END  METHOD 


**************** **************** ******** 


8 


Sat  LEAP  for  use  with  info  routine. 

User  enters  the  ranse  of  unit  numbers  (1st  and  1st 
nos.  when  METHOD  =  seauence  or  2  roup,  one  no.  when 
METHOD  =  random. 

LEAP=3 

IF(INV(7> .ME. 2) THEN 

PRINT*.  '  ENTER  FIRST  AND  LAST  UNT7  NOS.  <1NF3*0,0> ' 

READ*.  INVt  3)  » INV ( ? ) 

CALL  VERIFY  ( INV <  3 ) » IN'J ( 9  ) » *35 ) 

ELSE 

PRINT*,  '  ENTER  UNIT  NUMBER.  <INF0=0>' 

READ*. INV ( 8 ) 

INV(?)=INV(8)  Unitialize  last  unit  no. 

END  IF 

IF ( INV ( 9 ) . EG . 0 ) CALL  INFO (LEAP, *35) 

INV( 10)=INV(3)  ^Initialize  current  unit  no. 

CALL  VERIFY (INV(9> ,MAXV (8) » *35 > 

RETURN 

END  UNTN03 

•**X*****X*X**X**X**X*XX*XXX*X*X**X***XXX*X** 

SUBROUTINE  NUFILE 

When  FILE  TREATMNT  =  2,  initialize  new  file. 

CALL  ZOT 

DO  33  L  =  1 , INV( 15  > 

DO  94  K*1 , MAXV ( 8 > 

WRITE <UNIT  =  <IFIL< 2 >+L)»REC=K.ERR*89>  ( I  AM AT ( J , L ) >  J=  1 , MAXV ( 
CONTINUE 
CONTINUE 
INV(6)=5 
LEAP=9 

PRINT*,  '  ENTER  METHOD  TO  BE  USED.  < INFO* ) ' 

PRINT*,  '  1.  UNITS  IN  SEQUENCE  2.  RANDOM  UNITS  3.  GROUPS 
READ*.  INV ( 7 ) 

IF(INV(7).EQ.O)CALL  INFO (LEAP. *85) 

CALL  VERIFY < INV<7) ,MAXV<7> ,*35) 

RETURN 

CALL  FILERR ( *30 ) 

END  NUFILE 

*****  *  *  *  *  *  ********  *  *  X  *  *  *  *  x  X  *  *  *  *  * :«  *  X  X  * 

SUBROUTINE  COPFIL 

When  FILE  TRTMNT  =  1,  copy  read  file  into  write  file. 

DO  209  .1*1 , JNV(  15) 

DO  203  I  =  1 » M A X V ( 3 ) 

READ(UNIT=( IFIL< 1 )  +  J ) » PEC* I » ERR* 2S  ) < [ AM AT • L , J  * , L* t » MAXV  < 1 1 
WRITE  ( UNIT=(  IFIL<2 )  +  J5  »REC=I  ,ERR  =  28>  ( I  AM  AT  <  L. ,  J •  L*  1 » MA  x  V  < 
CONTINUE 
CONTINUE 
RETURN 

CALL  FILERRX *207 ) 

END  COPFIL 

***X**X*XX:«:«*XXXXXXX:**XXXX:xAXXX*XXt*X*X* 

SUBROUTINE  LNLUN 

load  J  list  a  specified  unit  from  the  files. 

CALL  FETCH 


RETURN 

END  LNLUN 

******************************************:»**i*** 

SUBROUTINE  FETCH 

obtain  unit  specified  in  INV<10>  from  each  file 
an d  load  it  into  IAhAT  array,  I F I  designates  which 
files  will  be  read  from. 

IFI=IFIL(2) 

IF( INV( 13) .EQ.3)THEN  3if  F i LE  TRTMNT=3 

PRINT*.  '  IS  UNIT  TO  RE  READ  FROM  SAME  FILE7  <i=iES)' 
READ*. IANS 

IF( IANS.NE. 1 ) IFI=IFIL( 1 ) 

ENDIF 

DO  41  J=1 * INV ( 15 ) 

READ < UNIT* (IFI+J) ,REC=INV( 10) ,ERR=43) ( I AMAT( L .  J  / , 1  =  1  .MAX v'l 
CONTINUE 
RETURN 

CALL  FILERR ( *40 ) 

END  FETCH 

***************  **********************1:*****. ****** 
SUBROUTINE  WINDOW 

print  the  attribute  array  for  each  Cl. 

IF( INV( 15) . EQ.3)THEN 

WRITE (a. 11)  UNAME(INV(10)). ( ( ( I  AM AT ( I . J i » I=K . K  +  4  < . 

J=1 » INV< 15 ) ) »K  =  1 »MAXV i 1 1 ) » 5 ) 

ELSE 

IF(INV(15).EQ.2)THEN 

URITEI6,  12)  UNAME<UiV(lO)>,(  (UMATCrJ)  ,I=K.Nt4), 
J*1 . INU ( 15) ) . K*1 . MAXU ( 1 1  i » 5  > 

ELSE 

UR ITE ( 6 . 13 )  UNAME ( INU( 10) ) » ( IAMAT ( I » 1 ) » I=J , MAXV < 1 1 
ENDIF 
ENDIF 

FORMAT </. IX. A8, 414. 15. 414. 15.414, 15. /.(9X, 41 4. 15. 41 4, 15, 4T 4 
F0RMAT(/.1X.A8.3X.5I5.3X.5I5./.<12X,5I5,3X.5!5>  > 

FORMAT (/, IX » A8.3X, 515 »/,<12X, 515, 3X>) 

RETURN 

END  UINDOU 

******************** ******************* ******** 
SUBROUTINE  BRANCH 

Branch  to  operation  as  specified  by  user. 

GOTO< 61. 62- 63.64,65) INV< 6) 


CALL  EDDEM 
RETURN 

CALL  CQPYUN( *69 ) 
RETURN 

CALL  F'RNTFL(*69) 

RETURN 

CALL  ROUGH 

RETURN 

CALL  NEWFLS 

RETURN 


Center  changes 
Scopy  sequence 
?print  from  files 
Schange  by  individual  row 
Senter  changes  into  new  files 


BRANCH 


SUBROUTINE  PRNTFL < * ) 

Print  data  from  files  resardina  units  listed. 

PRINT*,  '  PRINT  LOCALLY  OR  AT  DPFO?  d=LQCAL) 

READ*,  IANS 

IF ( IANS . £Q .  1 >  THEN 

DO  74  IJ=INV(9) * CNV<9)  0unit  nos.  specified 
INVdO)  =  IJ 
CALL  LNLUN 
CONTINUE 
RETURN  1 
ELSE 

DO  76  1  =  1 ,  INV( 15) 

DO  78  J  =  1 »NAXV< 8) 

READ<  <  IFII.(2)  +  I)  ,REC  =  J>  (IANATCK,  I ) , K=1  »,**A XUCl 
WRITE  ( (IFIL(3)  +  I)  ,1113)  J ,  UNAMEf  J ) ,  ( I AMAT  <  K  .  I) ,  K  =  1 .  rAXV  ( 1 1 
FORMAT (/,2X, 12, ' . ' ,2X,A3»3X»5I5*/t (13X.5I5) > 

CONTINUE 
CONTINUE 
ENDIF 
RETURN  1 

END  PRNTFL 

***X*******X***********X*****************X**xxxx* 
SUBROUTINE  EDDEM 

Enter  changes.  All  options  in  CHNG3  available. 

CALL  ININD(3»9) 

CALL  STATISd.MAXVdO)) 

CALL  INIT 

CALL  FETCH  ©change  to  LNl  UN  fnr  fiie  check 

CALL  CHANGD 
CALL  NXTUF'N<*625) 

CALL  WINDOW  0chk  contents  of  array 

CALL  PLIST 

CALL  SAVARUNVdO)) 

CALL  NXTUNT ( *623 ) 

RETURN 

END  EDDEM 

XXXXXXXXXXXXXlXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 

SUBROUTINE  COPYUNU) 

Copy  one  sequence  of  units  into  another.  Options 
incl  new  demand,  save  and  list.  Current  units  fin 
INV ( 8  S  9))  are  copied  into  the  unit  no.  in  INUd2) 
(INV(ll)  holds  1st  new  unit).  When  complete,  the 
copied  units  are  set  to  current  status. 

CALL  ININDf 1 » 10) 

INB<8)*1 

CALL  STATISC9, 11 ) 

CALL  INIT 
INVdO)  =  lNV(8) 

PRINT*,  '  ENTER  FIRST  UNIT  NO.  TO  BE  COPIED  INTO.  ' 
READ*,  INVdl ) 

CALL  VERIFY ( INVdl)  »MAXVi8) ,x899) 

INV( 12)  =  INV( 11 ) 


r_>  o 


CALL  DUPE ( INV( 12) ) 

INV( 12'=INV( 12)+1 
89?  CONTINUE 

INU  ( 8 ) = INV ( 11) 

INV<9)=INV<12)-1 

INV(10)*INV(?) 

RETURN  1 

C  END  COPYUN 

C  M****************************-******************** 

SUBROUTINE  NEWFLS 

C  Enter  changes  into  newly  created  files.  All  options 

C  available  except  'locate  by  ammo  code.1 

CALL  ININD(5,9) 

CALL  ST1  ‘IS<1»11) 

S02  CALL  INIT 

CAIL  FETCH 

301  CALL  CHANGE! 

CALL  NXTUPN<*801) 

CALL  WINDOW  9chk  contents  of  array 

CALL  PLIST 

CALL  SAVAR(INV( 10) ) 

CALL  NXTUNT ( *802 ) 

RETURN 

C  END  NEUFLS 

C  *******:*.***:«:*:**:*:***:«:*  *  :n  *  *  *  :t  ******  :**:«***  S;  :tc  *  *  :*  *  *  :k  *  * 

SUBROUTINE  ININD(J.K) 

C  Initialise  the  status  indicator.  Default  value  is  1. 

C  Status  0  determined  by  calling  routine  ( J,K=liaits> . 

DO  610  1*1 » (MAXV( 1 0 Y  —  1 ) 

IND( I )=1 

610  CONTINUE 

DO  620  I* J * K 
IND ( I ) =0 

620  CONTINUE 

IND (MAXV ( 10 ) ) =0 
•  RETURN 

C  END  ININD 

C  ********** ***** ******* ************ *********** 

SUBROUTINE  STATIS(LL.KK) 

C  Display  options  valid  for  the  calling  routine  and 

their  value  < 1  =  do  change*  0  *  don't).  ICH  =  1  if 

status  is  altered.  LL-KK  =  options  to  he  displayed. 
LEAP=5 
ICH=0 

70  PRINT*.  '  STATUS  OF  OPTIONS:  ( 1=CHANGE »  0=STAY  SArtE)' 

URITE<  6 » 1 1 17)  (I.  CHNGSU),  IND< I) ,I=LL*KK ) 

1117  FORMAT  ( /  .3(2X.  13. ' .  '.A10.'  *  .ID) 

C 

PRINT*,  '  TO  ALTER  3TATUS,  ENTER  ITEM  NO. (0=N0NE? INFO*??) 

71  READ*,  IANS 

IF ( IANS.EQ.O) THEN 

IF ( ICH.GT .5) WRITE( 6, 11 17 ) ( I ,CHNGS< I ) » IND v I  ■  ,  T=LL,KK 
RETURN 
ENDIF 


3-152 


CALL  VERIFY ( IANS .KK»*71 ) 

IF ( IND( IANS) .EQ.O ) THEN 
IND( IANS) =1 
ELSE 

INB<IANS)=0 
END  IF 

ICH=ICH+1  Gset  alter  indicate 

GOTO  71 

END  STATIS 

SUBROUTINE  INIT 

Initialize  variables. 

DO  110  1  =  1 » INV  < 15) 

DO  120  J  =  1 » 6 
MNT ( J. I )=Q 
KMB ( J* I ) =0 
RNDS( J » I )  =0 . 0 
CONTINUE 
RNDT ( I ) =0 . 0 
DO  122  JS1 »KAXV( 1 1 ) 

IAMAT ( J* I ) =0 
CONTINUE 
CONTINUE 
DO  124  1=1.6 
DO  123  J= 1 » 6 
IUPV<I,J)=0 
CONTINUE 
UPN( I  )  =  ' 

AMON(I)=' 

CONTINUE 
RETS=0.0 
KC0L=1 
KR0U=1 
INV(5>=0 
RETURN 

END  INIT 

I******************************************** 

SUBROUTINE  CHANGD 

User  enters  options  3S  indicated  by  CHNGS  status. 

********** 

Locate  specific  aaao  code.  Need  not  be  in  order. 
LEAP=10 

IF(IND(12).NE.1)G0T0  73 
PRINT*.  '  ENTER  ANNO  CODE!  (INF0=99)' 

READ*.  INV < 14) 

IF( INV( 14 ) .EQ. 99 >CALL  INFO (LEAP. *75) 

KR0U=1 

KC0L=5*KR0W-4 

IF ( IAMAT ( KCOL  > 1 ) . SO . INV( 1 4 ) >  GOTO  73 
KR0W=KR0U+1 
IF (KR0U.LE.6)G0T0  74 

PRINT*.  '  Artf.T  CODE  NOT  FOUND.  TRY  AHA  IN.  ' 
GOTO  75 

********** 


FORMAT ( / * 10X , ' FOR  WPN  NO.  ',12*'  OF  UNIT  ',13. 

'  ENTER  THE  FOLLOWING: ' ) 

Determine  tne  weapon  system  number. 

LAF'  =  1  Qoffset  for  NUUPN  rout  i no 
IF ( INO ( 3 )  .£Q.i)CALL  NUWF'N < LAP , *37. #750 ) 

CALL  CURUF'N<  *750 ; 

********** 

Determine  the  total  no  of  weapons  alive.  For 
information,  user  enters  99  as  1st  entry  and 
any  inteser(s)  for  the  other(s)-  To  :ero  out 
the  rest  of  the  array  for  the  entire  phase, 
user  enters  9999  as  first  input.  .  .etc. 

IF ( IND< 1 ) .EQ. 1 ) THEN 
LEAP=1 1 

PRINT*,  '  NO.  OF  UPNS  ALIVE  PER  CIJ  < NQNE*0» INF0=99 
READ*,  ( I  AMAT ( KC0L+1 » I > » 1*1 , INVv 15 ) ) 

IF ( IAMAT ( KC0L+1 , 1 ) . EQ . 99 >CALL  INFO- LEAP, *37) 

IF ( I AMAT ( KCOLrl • 1 ) . EQ . 9999 ) THEN 

KR0W=6  3set  row  ind;;  to  last  rou 

DO  371  1  =  1 , INV( 15  ! 

DO  372  J=KC0L, 30 , 5 
DO  378  K  =  1 , 4 

I AMAT ( J+K , I ) =0 
CONTINUE 
CONTINUE 
CONTINUE 
RETURN 
ENDIF 
ENDIF 

********** 

Determine  total  no  of  wpns  firms  (short  of  ammo) 
IF ( IND ( 2)  .EQ.DTHEN 

(Artillery  receive  ammo  differently.) 

IF ( IUPV ( KROU  *  1 ) . GT . 7 . AND . IUPV ( KROU, 1 ) . LT , 1 1 ) THEN 
PRINT*,  '  NO.  OF  UPNS  RECEIVING  AMMO  PER  CH  ' 
ELSE 

PRINT*,  '  NO.  OF  UPNS  SHORT  PER  CT :  <0=N0NK)' 
ENDIF 

READ*,  ( IAMAT(KCOL+2» I ) » 1=1 « INV< 15) ) 

ENDIF 

Verify  wens  3live  Si-eater  than/eaual  wens  short. 
For  artillery,  test  does  not  apply. 

IF  ( I  UP  V(  KRQU,  1 )  .GT ,  10,  OR .  IUPV <  KROU »  1  >  .LT.8  >THFN 
IANS=0 

DO  370  1=1 , INV ( 15 ) 

IF ( I AMAT (KCOL+2, I ) .GT. I AM AT ( KCOL+1 , I ) ) IANS= 
CONTINUE 

CALL  VERIFY ( IANS, 0,* 37) 

ENDIF 

********** 

Enter  the  no.  of  maintenance  returns. 

IF( IN0(5) .EQ. 1 ) THFN 

PRINT*,  '  NO.  OF  MAINTENANCE  RETURNS  PER  Cl J  (0=NONE 
READ*,  (MNT(KR0U,I ) .  I  =  1.INV(15)) 


INV<5>*4  ?set  indicator  for  returns 

END  IF 

tttn.it**** 

Enter  the  no.  of  combat  reserves. 

if;ind(6).eq.dthen 

PRINT*.  '  NO.  OF  COMBAT  RESERVES  PER  CTJ  tO=NONE>' 
READ* •  (KhB(KROU.I) .1*1 *INV( 15) ) 

IF<  IND<  11 )  ,NE .  1.  AND.  INDw)  .NE.l/CALL  QLOEM 
INV(5)*4  0set  indicator  for  returns 

ENDIF 

********** 

Enter  the  no.  of  attack  helicopters  per  ce l I . 

IF ( IND<  4) .EQ. 1 • AND. < IUPV( KROU, 1 ) .EQ. 12 .OR . IUPV ( KROU. 1 ) . E 
PRINT*.  '  NO.  OF  ATK  HFLIS/CE1  L  PER  CIJ  :}=NQNE)' 
READ*,  <IAMAT(KC0L+3,I)  ,I  =  1,INVU5> ) 

ENDIF 

********** 

Enter  a  preselected  demand. 

IF(IND(7).EQ.1> THEN 

PRINT*,  '  PRESELECTED  DEMAND  PER  CIJ  < INTEGER  ONLY)' 
READ*,  ( I Art AT  (KCOL  +  4, 1 ) ,  1  =  1 ,  INV  ( 1.5) ) 

ENDIF 

Data  for  howizters  is  duplicated  for  each  ammo  typp. 
IF ( IUPV ( 1 , 1 ) .EQ.8»0R.IWPV( 1,1) ,EQ ,9)THEN 

MX=4  0#  of  add.  ammo  types  for  155  how 

IF(IUPV(1,1).FQ.8)MX=2  0for  8* 

DO  374  J*1,INV(15) 

DO  376  I=5»5*rtX,5 

IArtAT(I+2»J)*IAMAT(2, J) 

I Art AT (I+3,J)*IArtAT(3,J) 

IF(IND(7).EQ.l ) I AH AT  <I+5,J)  =  IAMAT(5,J) 
CONTINUE 
DO  377  K*2,rtX+l 

MNT (K,J)=rtNT(l,J) 

KMB(K , J) *KMB( 1 , J) 

CONTINUE 

CONTINUE 

ENDIF 

********** 

generate  new  demand. 

IF<  IND<  11 )  .EG.DCALL  DEMAND 
RETURN 

END  CHANGD 

**************************************** 

SUBROUTINE  DEMAND 

Demand  factors  (MQPP,  Battle  Intens,  Phase,  New  Rfts) 
are  polled  for  each  unit.  Ammo  and  upn  types  entered 
if  necessary.  Expenditure  rates  difference  calculated 
and  verified.  New  demand  generated. 

IF( KROU.EQ . 1 .OR. INDv 12) .EQ. 1 ) THEN 

CALL  DEFACT  0if  1st  wpn,  check  DMD  FACTORS 

ELSE  0check.  if  new  wpn  rets  needed 

IF(  INV< 5)  .NE.O .AND.  INV( 5)  .NE .4) CALL  CHKH'ET 


CALL  CURUPN< *375 )  Sobtain  current  wen  tsee 

IF(IUPV(KR0Uf1)»EQ.14> THEN  3new  wen  tsee 
PRINT* t  ‘  ENTER  NAME  OF  NEU  UPN  SYSTEM.' 

READ*  >  UPN(KROU) 

ELSE 

UPN(KRQU)=UPSYS( IUPV (KROU. 1 ) ) 

ENDIF 

IF(INV<3>.EQ.8)THEN  Gnew  ammo  tsee 

PRINT*.  'ENTER  NAME  OF  AMMO  TYPE' 

READ*  *  AMQN(KROU) 

PRINT* .  '  ENTER  HIGH  AND  LOU  EXPENDITURE  RATES.' 
READ* .  IUPV<  KROU. 2 ) . IUPV<  KRQU . 3 ) 

ELSE  9ammo  expenditure  rates 

IUPV  <  KROU  .  2 ) =MAXAR < IUPV  <  KROU . 1 > . I NV ( 3  )  ) 

IUPV(KRQU. 3>=MINAR( IUPV (KROU. 1 ) . INV(3) > 

ENDIF 

CALL  UERIFY(IUPV<KR0Uf3)f IUPV<KR0U*2) .*373) 

IUPV ( KROU  f  6 )  =  IUPV ( KROU  f  2 ) -IUPV <  KROU f  3 ) 

*********** 
demand  calculations 

A  random  no.  is  sener3ted  and  multiplied  by  the 
expenditure  rate  diff.F  the  lower  limit  is  addedF 
and  the  result  rounded  and  saved  3S  ‘das's  draw.* 
The  phase  period  draw.  eouals  a  proportion  of  the 
total  ( .6=das. .4=nisht>  *  MOPP.  The  Cl  draw  emials 
a  proportion  of  phase  total.  For  helicoptersF  phase 
total  =  das  total.  A  new  draw  is  made  for  each  Cl. 
IF ( IUPV ( KROU f 1 ) .EQ. 12 .OR . IUPV <  KROU f t ) .EG. 13 » THEM 
IUPV ( KROU  f  4 ) =0 
DO  48  1*1 f INV( 15) 

DRAU=RANF ( DUM  > 

DRAU  =  DRAU* IUPV ( KROU  f  6 ) +IUPV ( KROU f  3 > 

IF(NINT<DRAU) . LT . IUPV( KROU. 3 ) >S0T0  47 
RNDS(KROUfI)=NINT(DRAU) 

IUPV (KR0U»4 )*IUPV( KROU. 4 ) +RNDS( KROU  f I i 
RNDT(I)=RNDS(KR0UfI)*[AMAT(KC0L+2fI)  0tot  rnds 
CONTINUE  . 

IUPV( KROU f5)sIUPV( KROU .4)  Sphse  drau*tot  draw 
ELSE 

DRAU*RANF(DUM) 

DRAU=DRAU* IUPV ( KROU  F  6 ) + IUP V ( KROU  F  3  > 

IF ( NINT< DRAU ) .LT . IUPV < KROU. 3) )G0T0  44 
IUPV ( KROU. 4 i =NI NT ( DRAU  ) 

IF(INV<4).EQ.1)THEN 

DRAU*DR AU*0 . 6* I NV { 2 ) / 1 00 .  ?das  draw 

ELSE 

DR AU=DR AU*0 . 4* INV ( 2 ) / 1 00 .  Snisht  draw 

ENDIF 

IUPV(KR0U.5)=NINT(0RAU)  Gehase  draw  saved 

********** 

Determine  cumulative  rounds  eer  wen  eer  Cl. 

CUM*0.0 

DO  42  1=1 . INVv 15) 


CUM=CUM+RNDS  ( KRGU 1 1 ; 

CONTINUE 

JST=0 

DO  43  J=1 f INV ( 15 ) 

RNDS (KRGUf  J) =NINT  ( RNDS ( KRGU f  J )  /CUM*GRAW) 

IF(RNDS<KROU.J) . LT . 1 . 0 j RNDS ( KROU » J ) =1 , 0 
Test  for  d ivad  (3  rnd  =  90  bursts). 

IF ( IUPV ( KROU f 1 ) .EQ . 1 1 ) THEN 

RNDS(KROUt J)=NINT ( RNDS ( KROU *J)/90.0) 

IF ( RNDS ( KROU . J) . LT . 1 . 0 ) RNDS ( KROU  r  J )  =  1 . 0 
RNDS  <  KROU » J )=RNDS( KROU . J  >  *90 
ENDIF 

Tests  for  howitzers. 

IF  ( IUPV  (KROU  f  D  .  EQ .  9  .  AND .  RNDS  ( KROU .  J)  ,3T.  ( 600 .  /  I N  '•}  (15)/) 
IF(  IUPU ( KROUf  1 ) . EQ .3 .  AND. RNDS ( KROU •  J )  .ST .  ( 300 .  /  IN',' ( IS) )  /.} 
Total  rounds  =  rndstwens  short. 

RNDT ( J)=RNDS(KROU» J i * IAMAT <  KCOL  +  2  *  J )  8 tot  rods 

CONTINUE 

IF ( JST . NE . 0 ) GOTO  46 
ENDIF 

********** 

Incorporate  mnt  returns  \  cab  reserves  into  tot  rods. 

Calculate  howitzer  rounds  for  each  ammo  ty;>e. 

DO  45  1*1 f INV(15) 

IF( IUPV ( 1 1 1 ) . EQ .9 ) THEN  3155  howitzers 

DO  451  J=1 f 5 

RETS*KHB( J»I )+HNT( J» I  )/2. 

IF(INV(10).LT.12) THEN 

I AMAT ( J*5 *  I ) *NINT( F‘ER(  J ) *RNDT(  I )  +  ( IHOUL(  J ) *RETS ) ) 

ELSE 

IAMAT ( J*5  f  I )  =NINT  ( PER  ( J )  *RNDT  ( I  >  +  ( IHOUL  ( J+5 )  *R'ETS ) ) 
ENDIF 

RNDS( J» I ) =RNDS< 1 t I )  3dupe  rnds/wen 

CONTINUE 
ELSE 

IF ( IUPV ( 1  f  1 ) » £9. 9) THEN  39-inch  howitzers 

DO  452  J=1  f3 

RETS=MNT ( J> I ) /2.+KM8 ( J » I ) 

IAMAT (J*5  f I ) =NINT (PER  < J+5) *RNDT ( I )  +  IHOUL ( J+10) *RETS ) 
RNDS( J > I ) *RNDS< 1 » I )  3dupe  rnds/wpn 

CONTINUE 
ELSE 

RETS*KMB( KROU 1 1 ) +MNT (KROU » I ) /2. 

IAMAT (KCOL+4 » I )=NINT(RNDT( I ) FLOAD( IUPV(KRnu. 1 ) )*RFTS) 
ENDIF 
ENDIF 
CONTINUE 
RETURN 

END  DEMAND 

**************************************** 

SUBROUTINE  NXTUPK  *) 

Determine  if  another  wpn  in  unit  is  to  be  chansed. 

.  .  .All  artillary  have  only  one  ’wpo'  entered. 
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CO  CJ» 


o  o 


IF (KRQU.GE.o) RETURN  Blast  row  in  array 

l\R0U=KRQU+ 1 

KC0L=5*KRQU-4 

C  Automatically  30  to  ne;:t  wrn  unies'.  inputting  ch3n3es. 

IF(  (IND(8)  .EQ.2)  .OR.  ( INV«  A.-  .!*E.1.AnD.INV<6)  .ME.5) ) RETURN  i 
IF ( INV (7) . EQ. 2> THEN 

PRINT**  '  ANOTHER  WFN  SYSTEM  FOR  UNIT7  (0-NG;  ' 

ELSE 

C  999  used  only  to  escape  seouential  entry  method. 

PRINT*.  ' ANOTHER  UPN  FOR  THIS  UNIT7  ( 0=N0 ; 9?9=EX I T  SEQ / ' 

ENDIF 

READ*.  IANS  Jeoll  if  enterjna  ch3nses. 

IF ( IANS .EQ . 999  >  Tm£n 
I ANS*0 

INV ( 9 ) »INV \ 10 ) 

ENDIF 

IF ( IANS .EQ.O ) RETURN 
RETURN  1 

END  NXTWPN 

****************************:{*********** 

SUBROUTINE  F'LIST 
C  Print  a  listing  of  the  ineuts  3nd  foctors  pertaining 

C  to  the  current  unit  onto  the  screen/loc  )1  printer. 

IF(IND(9).EQ.1)G0T0  50 
PRINT*,  '  LIST  THE  UNIT  STATS?  <1=YE5)' 

READ*,  IANS 

IF  < IANS.NE . 1 ) RETURN 
50  WRITE<  6, 1500 ) 

IF<INV<4).EQ.8)THEN 

WRITE(o»1503)  INV( 10) »UNAME( INV< 10) ) »DRN( INV( 4) ) , (WPN(T) » 

=  ( IUPV(I.J) ,J*1,5),AM0N<I> ,Id,6) 

ELSF 

IF ( IWPV< 1 » l ) .EQ. 9.0R. IWF V< 1 . 1 ) . EQ.3 ' THEN 
URITE( 6. 1506)  INVf 10) ,UNAME< INV< 10 ) ) »DRN<INV( 4 ) ) , UPN( 1 ) , 
z  (IWPVU.J) ,  J=l,5) 

URITE(6» 1508) 

WRITE(o»  1507)  ( ( I AMAT( I » J) , 1*5 , 25, 5) » J= 1 » INV ( 15 )  . 

ELSE 

WRITE(o» 1505)  INV( 10) .UNAME (INV( 10) ) ,DRN( INVf 4) ) . <WPN(I> » 
z  <  IUPV(  1 J ) » J-l  ,5) ,  1  =  1 .6 ) 

ENDIF 

ENDIF 

WRITE ( 6, 1501 ) 

DO  505  L=1 , INV( 15) 

URITE<  6. 1504 )  NOCI(L), ( ( 1AHAT(5*I-J,L) . J=4»l?-1) ,.MNTv I.L) . 
z  KMB ( I , L ) »RNDS ( I ,L) , I AMAT ( 5*1 » L ) » I"1 » a 

505  CONTINUE 

RETURN 

1500  FORMAT'/, 5X, 'UNIT' ,5X, 'PHASE  WEAPON  SYSTEM  AMMO  EXPENDITURE-' , 

z  'DEMAND  (NEW  AMMO) ' »/»2IX. 'NAME ' ,7X. 'NO  (  LIMITS  )'• 

z  '  DRAW  /PHASE') 

1501  FORMAT ( / »?X » ' Cl  AMMO ', 4X , 'WEAPONS 4X ,' AHS/  RETURNS  ROUNDS  ', 

z  'SPENT'  ,/,9X,  'NO  CODE  ALIVE  SHORT  CELL  MNT  r.;iR  . 

z  '  /TUBE  TOTAL') 
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FORMAT ( / .  IX .  I2.2X  .  A8 .  IX .  A5. 2X>  A10. 13-  Is.  15 . 217. 2X .  AlO . 
:  A10.I3.I&.I5.2I7.2X.A10U 

FORMAT (/ . IX, 12. 2X.A8. IX. A5.2X.A10. 13.16. 15.217./. (21X. 
:  A 1 0  .  1 3  *  1 6 , 1 5  *  2 1 7  ) ) 


/  i  ■  j  l  < » 


FORMAT (/.9X. 12 , 16 . 17*216. 15. 14* 1 X.F6. 1 . 17 . / »  < 1 IX *  16 ,  T 7 , 21 A . 13 
:  I4,1X.F6.1.I7> > 

FORMAT! /.IX, I2.2X, AS. 1X.A5.2X.A10. 13 » la. 15*217) 

FORMAT ( / ,30X .416 » 15  > 

FORMAT < /» 31X. ' HOWITZER  DEMAND  BY  ArtnQ  TYPE ' »  / » 33X , 
z  'HE  I CM  RAP  CLGP  ETC.'* 

END  PLI3T 

**************************************** 

SUBROUTINE  3AYAR (N ) 

Save  unit  attributes  (IAMAT  array)  in  record  mb. 

'  by  N  (=  unit  no).  If  auto  save  not  specified  in 
STATUS*  user  is  polled. 

IFUNDUO)  .E3.DG0T0  501 
PRINT*.  '  SAYE?  ( 1=YES ) ' 

READ*.  IANS 

IF ( IANS.NE. 1 ) RETURN 

Howitzers;  wens  alive  copied  into  wens  short. 

IF <  IUPY <  1 » 1 )  .EQ.8.0R .  I!dPV(  1 . 1 )  .EQ.  ? )  THEN 
DO  502  I  =  1.INUU5) 

DO  503  J  =  2 .27.5 

IAMAT! J+1,I)=IAMAT!J,I) 

CONTINUE 

CONTINUE 

ELSE  01 f  divad*  set  wens  sht-wpns  3live 

DO  504  1*1  .  INU< 15) 

DO  506  J= 1 i o 

IF (IUPY! 1,1)  .EQ.  10)  IAMAT(5*J-2  *  I  )*IAMAT(  5*-J-3 » I ) 
CONTINUE 
CONTINUE 
ENDIF 

DO  778  1*1 . INV( 15) 

WRITE! UNIT*! IFIL< 2>  +  I >  »REC=N»ERR=779>  ( IAMAT { J .  1 1 » J *  1 ,  M  A  •<  Y 

CONTINUE 

RETURN 

CALL  FILERRU777) 

END  SAYAF: 

***********X***:ii*  ********************  ****x** 

SUBROUTINE  NXT'JNT i  *) 

See  if  the  unit  gust  modified  is  to  be  copied* 
and  if  it  is  \  the  ma:;  in  seauenre.  Increment 
current  unit  no  and  copy  sequentially  if  INV!7>s3. 

IF < IND ( 3 > . EQ . 1 . AND . INY ( 7) , NE , 3 ) CALL  DITTO 

IF ( INV ( 1 0 ) . GE . I  NY ( 9 ) . AND . INY • 7  > . NE . 3 ) RETURN 

INV<10)=INY(10>tl 

IF ( INY (7) .NE. 3) RETURN  1 

DO  939  JK  =  INV  < 10 ) , INV! 9  > 

INV( 10)=JK 

CALL  DUPE(INY(10) ) 

CONTINUE 
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END  NXTUNT 

***********************************************.«** 
FUNCTION  NXTSTP(dum) 

Return  v3lue  of  the  ne::t  operation  desired  by  user. 
L£AP=7 


du®*0 

PRINT*. 

PRINT*. 

PRINT*. 

PRINT*. 


WHAT  NEXT?  <INF0*O>' 
1*C0NTINI!E  METHOD 
3=C0F'Y  UNITS 
5=PRINT  MODIFIED  FILE 


2=CHANoE  METHOD' 
4=NEW  RUN' 

6=END' 


READ*.  IANS 

I F (I ANS . EQ . 0 ) CALL  I NF 0 ( LEAP . *900 > 

CALL  VERIFY (IANS. 6 .*900) 

NXTSTP=IANS 

RETURN 

END  FUNCTION 

******************************:!:*************** 
SUBROUTINE  NUCIU) 

Start  3  new  run. 

PRINT*.  '  CAUTION.  ROUTINE  ONLY  WORKS  IF  ADDITIONAL' 
PRINT*.  '  UNITS  WERE  ASSIGNED  IN  THE  SPG  RUNSTREAM.' 
READ*.  IANS 

IF ( IANS.NE.l ) RETURN  1 
DO  400  1=1 » INV ( 15 ) 

CLOSE  ((IFIL(1'+I)> 

CLOSE  <<IFIL(2)H)> 

CONTINUE 

CALL  INIT 

IrIL<l)=IFIL(l>+9 

IFIL(2)=IFIL<2>+9 

IFIL(3)=IFIL(3)+9 

RETURN  1 


END  NUCI 

******************************************** 
SUBROUTINE  rouch 

Enter  changes  to  each  column  of  row  specified  in  Cl 
specified  (1.2.3).  Rous  may  be  siven  in  any  order. 
IROU:  ch3nses.  JR*  Cl  and  row  nos?  LP5  inder; 
DIMENSION  IR0W(1S.5) *JR<13.2) 

DATA  IROU/90*0/ »  JR/36*0/ 


CALL  ININD< 1»MAXV< 10) ) 

CALL  STATISO.  10) 

CALL  INIT 
LEAP*  1.2 
LP=0 

CALL  LNLUN 
LP*LP+1 

PRINT*.  '  ENTER  Cl  (1-3)  AND  ROW  (1-6).  (INF0*0.O)' 

READ*.  <JR(LP.I).I=1.2) 

IF(JR(LP.l)  .EQ.O.OR.  JR  <  LP.  2 ) .  EQ.  O.'CALL  INFO  (LEAP.  *661 ) 
CALL  VERIFY < JR ( LP . 1 ) » INV ( 15> .*661 > 

CALL  VERIFY < JR (LP  >2 ) >6?*661 ) 


3-160 


o  O  o  o  o  o  o 


READ*,  ( IROU ( LP » I > » 1*1 » 5 ) 

IF( LP.LT. 13  > THEN 

PRINT*,  '  ANOTHER  CHANGE  FOR  THIS  UNIT’  !l=fE3>' 
READ*,  IANS 
IFdANS.EQ.DGOTO  6a5 

ENDIF 

667  DO  668  K=1,LP 

I=JR(K> 1 )  8CI  no. (1,2,31 

J=5XJR(K,2)-5  Grow  offiet 

DO  664  L*l»5 

IAMAT<  J+L, I )aIRQW (K,L) 

664  CONTINUE 

668  CONTINUE 
CALL  WINDOW 

CALL  SAVAR(INV( 10) ) 

IFdNV(7) . EQ.2)THEN 

PRINT*,  'ANOTHER  UNIT?  (N0=0?  YES=NEW  UNIT  NO.)' 
READ*,  IANS 

IF(IANS.EQ.O)RETURN 
INV< 10)*IANS 
IF(IND<8).EQ.1)G0T0  667 
GOTO  660 

ELSE 

IF (INV( 10  .GE. INV<  9 ) )RETURN 
INVU0)*INV<10)H 
IF(INV(7) .E 0.1) GOTO  660 
IF(  INVOKED. 3) GOTO  667 
ENDIF 
RETURN 

C  END  RQUCH 

C  X**************************************  ***:«*:** 

SUBROUTINE  DEFACT 

Factors  not  saved  in  the  files  which  affect  demand 
are  listed.  Chaoses  are  made  bs  entering  the  factor 
no.  and  its  new  value.  Note!  MQF'P  value  is  integer 
and  eouals  100  tiees  the  real  HOPP  FACTOR. 

LEAPS  for  use  with  info  routine?  IANS!  v3r  to  be 
changed?  IANS+1!  the  index  holding  the  new  value. 

15  PRINT*,  'CURRENT  DEHAND  FACTORS  ARE!' 

WRITE<6>1515)  ( INV< I) , I»2»5> 

1515  FORMAT  (/,  IX, '  1 .  HOPP  *  ',13,'  2.  INTENSITY  =  ',H» 

2  '  3.  PHASE  *  ',11,'  4.  NEW  RETS  =  ',13,/) 

LEAP»2 

PRINT*,  '  ENTER  FACTOR  AND  NEW  VALUE.  (N0NE=0»0?INFQ*0«FAi:Ti 
20  READ*,  IANS,  INV < IANS  +  1 > 

CALL  VERIFY ( IANS , 4»*20 ) 

IANS  »  IANS+1 
IF(IANS.EQ.1)G0T0  25 

CALL  VERIFY ( INV( IANS) ,MAXV(IANS) ,*15) 

I F < IANS.EQ.3.0R . I ANS.EQ. 4 )THEN  3must  exclude  0 
CALL  VERIFY  ( ( INV<  IANS)-1  i  ,MAXVdANS)  ,*15) 

ENDIF 
GOTO  20 


IF <  INV , 3) . N£ ,0 .  AND.  INV (5 ) • NE. 4 ) CALL  CHKRET  grets 
RETURN 

END  DEFACT 

******X**********t****t****X*t***** 

SUBROUTINE  CHKRET 

Enter  new  snt/coiabat  rets  far  upn. 

IFdNV( 5)  .GT .  1 ) THEN  gn*w  ent  returns 

PRINT*.  '  ENTER  MNT  RETURNS  FOR  EACH  Cl.' 

READ**  (MNKKRQU.  I ) » 1  =  1 » INVdS) ) 

ENDIF 


IF  d NV  ( 5 ) .  EO .  1 .  OR .  I NV  <  5  > .  EO .  3 )  THEN 

PRINT*.  '  ENTER  COMBAT  RESERVES  F(1R  EACH  CJ.' 

READ*.  (KMB(KROU.I) .I=1.INV(15) ) 

ENDIF 

IFdWPVd.l)  .NE.8.ANB.IWPVd»l).NE.9)RETURN 
MX=5 

IFdWPVd.l) .EQ.8)MX=3 
DO  414  I  =  1 » I NV  d  5 ) 

DO  415  J=2.MX 

MNT(J»I)=MNTd»I> 

K<MB<  J*  I )=KMB<  1 » I ) 

CONTINUE 

CONTINUE 

RETURN  x 

END  CHKRET 

************************************ 

SUBROUTINE  OLDEM 

If  returns  have  been  entered  but  no  deeand  generated* 
return  loads  calculated  and  added  to  old  deeand. 

DO  82  1*1. INV< 15) 

IFdUPV<KR0U»l).EQ.9)THEN 
DO  822  J=1.5 

RETS=KMB< J»I)+(MNT(J>I)/2. ) 

IF(  INVdO )  .LT  .42)  THEN 

I AMAT  < J*5. I ) *NINT < I AMAT ( J*5 . I ) +( IHOUL < J ) * RETS ) ) 

ELSE 

IAMAT(J*5.I)*NINTdAMAT(J*5»I)  +  (IHnUL(  J+5)*RETF.<> 

ENDIF 

CONTINUE 

ELSE 

IF dWPV<  KRQW. 1 ) , EQ . 3 ) THEN 
DO  823  J*1 .3 

RETS=KMB(J.I)+<MNT<  J.D/2. ) 

I AMAT ( J*5. I ) =NINT( I AMAT ( J*5. I )+( IHOUL( J+10)*RET3) ) 
CONTINUE 
ELSE 

RETS=KMB( KRQW > I )  +  <  MNT (KROU. I )/?. ) 

I  AMAT  (KCQL+4»I)*NINT(  I  AMAT  (KCOL+4. 1 )  +  ( LOAD  ( IWF'V(  KROU .  i ) )  *R'ETS ) ) 
ENDIF 
ENDIF 
CONTINUE 
RETURN 

END  SUB  OLDEM 


SUBROUTINE  CURHPNU) 

Obtain  current  weapon  system  from  file. 

IUPV(KRQU.1>*0 

IF< I AM AT ( KCOL , 1 ) . N£ .0) GOTO  38 

PRINT*.  '  NO  URN  TYPE  LISTED.  ENTER  UPN  CODE  UANTED ' 
PRINT*.  '  OR  GO  TO  NEXT  UPN.  (0*NEXT  UPN . INF0=99 ) ' 
READ*.  iyPV(KROU.l) 

IF ( IUPV (KROU, 1 ) .EQ. 0 ) RETURN  1 

LAP=2  Boffset  for  NUUPN  routine 

GOTO  387 

IUPV (KROU. 1)=IWPV(KRQU» i)+l 

IF ( IAHAT(KCOL» 1 ) .EQ.KUPSYS( IUPV (KROU. 1 ) >  > RETURN 
IFdUPV(KROM.l)  .LT.HAXV(9))G0T0  38 
CALL  ERRUPN<  *338 >  Bno  match  found 

CALL  NUWPN(LAP»*388>*389)  Bto  enter  new  wpn  type 

RETURN 
RETURN  1 
END  SUB  CURUPN 

******************************* 

SUBROUTINE  NUUPN(LTP»*,*> 

Enter  weapon  system  and  assign  proper  ammo  code  to 
array.  Howitzers  automatically  enter  all  ammo  codes. 
LIP  *  offset  to  determine  start  of  routine. 

LEAP** 

GOTO(36>361 >LIP 

PRINT*.  '  THE  UPN  SYSTEH  NUMBER  IS:  CNF3=99>' 

READ*.  IUPV(KR0U»1> 

IF ( IUPV <  KROU .  I ) .  EQ .  99  i  CALL  INFO ( LEAP  »*36) 

IF( IUPV ( KROU. 1 ) .NE.0)GQTQ  360 
DO  606  I*1»INV( 15) 

DO  607  J*KC0L,KC0L+4 
IAMAT ( J» I )*0 
CONTINUE 
CONTINUE 
RETURN  2 

CALL  VERIFY ( IUFV( KROU, 1 ) »MAXV<9 ) .*36 ) 

IF ( IUPV (KROU. I ) .EQ. 14) THEN 

PRINT*.  '  ENTER  NEU  AMMO  CODE  NO. ' 

READ*.  IANS 

DO  14  1*1, I NV (15) 

IAMAT(KCOL»I)*IANS 
CONTINUE 
RETURN  1 
ENDIF 

DO  16  1*1 » INV( 15) 

IAMAT (KCOL. I )*KHPSYS( IUPV (KROW. 1 ) > 

IF ( IUPV < 1,1) .EQ.9)THFN  Bhowitzers 

DO  161  J-1,4 

IAMAT((5*J+1>. t>*KHW(J> 

CONTINUE 

ENDIF 

IF ( iyPV< 1 » 1 ) .£3.8  >  THEN 
DO  162  J*1 , 2 

IAMAT < < 5*J+1 > » I > *KHH < J+4 > 


16 

C 

C 

c 

c 


931 

930 


332 


934 


937 

936 


C 

C 


C 

c 


933 


ENDIF 
CONTINUE 
RETURN  1 
END  SUB  NUUPN 

M****************************************** 
SUBROUTINE  COPYWP(NU’LRQ»*> 

Only  the  weapon  whose  ammo  code  is  specified  is 
copied  into  the  new  unit.  If  demand  is  senerated 
for  howitzers’  it  will  be  for  all  3mma  types. 
DIMENSION  KGPY(5’3; 

DATA  K0PY/15*0/ 

K0L*5*LR0-5 
DO  930  1*1 ’ INV( 15) 

.  DO  331  J=1 » 5 

K0PY< J» I ) *IAMAT ( KQL+J» I ) 

CONTINUE 

CONTINUE 

INV< 10) =NU  9new  unit  no. 

KR0U=1 

KCOL=5*KROW-4 

IF( IAMAT (KC0L» l ) .EQ . INO ( 14) )G0T0  834 
KRCU*KR0U+1 
IF (KR0U.LE.6)G0T0  332 

PRINT*’  'AMMO  TYPE  NOT  FOUND.' 

’RETURN  1 

LRO=KROU 

DO  836  1*1 » INU( 15) 

DO  837  J*l»5 

IAMAT ( KCOL+J» I )=KOPY <  J’  I  > 

CONTINUE 

CONTINUE 

IF ( IND< 11 ) .NE. 1 ) RETURN  1 
IF< IAMAT (l’l) .EQ. 4. OR. IAMAT (l’l) .EQ .6) THEN 
KR0U*1 
KCQL*1 
ENDIF 

CALL  DEMAND 
KC0L*5*LR0-4 
RETURN  1 

END  COPYUP 

***************** *************************** 
SUBROUTINE  DUPE<N) 

Data  for  one  unit  is  duplicated  into  another  unit. 
New  demand  is  senerat.ed  if  indicated.  List,  and 
save  are  polled.  N=unit  (record)  number  of  copy. 
IF(IND(12)  .EQ.DCALL  C0PYWP<N’KRnU’*?34) 

KR0H*1  9move  Ptrs  to  start  of  array 

KC0L*1 

IF( IND< 11) .EQ. 1 ) THEN 
CALL  DEMAND 

IND<8>=2  Savoid  nxtwpn  poll 

CALL  NXTUPNC *933) 

IND(8)*1  Sreset  copy  indicator 

ENDIF 
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CALL  SAVAfi'N) 

RETURN 

C  END  DUPE 

C  ************************************************* 

SUBROUTINE  DITTO 

C  Copy  one  unit  into  many  non-seouential  locations. 

930  PRINT*,  '  ENTER  NEW  UNIT  NO.  <0=N0NE)' 

READ* ,  IUNS 

IF (IUNS.EQ.O) RETURN 

CALL  VERIFY ( IUNS.MAXV ( 8 ) *  *930) 

CALL  DUPE( IUNS) 

GOTO  930 

C  END  DITTO 

C  ***************************************:  ****** 

SUBROUTINE  ZOT 

C  Set  attribute  array  to  0. 

DO  31  1=1 ,INV( 15/ 

DO  92  J=1 ,MAXV( 11 ) 

IAMAT ( j» I )=0 
82  CONTINUE 

91  CONTINUE 

RETURN 

C  END  ZOT 

c  m************************************* 

SUBROUTINE  INFO(JMP,*) 

C  print  messase  at  JNP  offset  and  return  to  *  location. 

C 

GOTO (255, 250, 256 ,257, 258 *261 ,259* 263, 264 ,266, 267, 268 >JMP 
C  LEAP=21  demand  factors 

250  CALL  VERIFY ( INV( 1 ) ,3«*249) 

GOTO (251 .252*253*254) I NV( 1 ) 

C  NQPP 

251  PRINT*,  '  ENTER  AN  INTEGER  EQUAL  TO  100*NGPP  FACTOR' 
PRINT**  '  IN  THE  RANGE  FRON  0  AND  100.' 

RETURN  1 

C  battle  intensity 

252  PRINT*,  '  BATTLE  INTENSITY  CHOICES  INCLUDE:' 

PRINT*,  '  1  =  DEFEND* INTENSE  5  =  BELAY , NBA-LIGHT ’ 

PRINT*,  '  2  =  DEFEND .MODERATE  6  =  DELAY*  CFA ' 

PRINT*.  '  3  =  DEFEND, LIGHT  7  =  ATTACK' 

PRINT*,  '  4  =  DELAY, MBA-INTENSE  S  =  SFECIFY  AMMO  RATES' 

RETURN  1 

C  time  of  day 

253  PRINT*,  '  ENTER  PHASE,  DAY/NIGHT.  (1  =  day,  2  =  msht) ' 
RETURN  1 

C  additional  vipn  returns 

254  PRINT*.  '  ’MORE  RETS*  SHOWS  IF  COMBAT  AND  HNT  RETURNS 
PRINT*,  '  HAVE  BEEN  ENTERED  FOR  THIS  WPN:  0=NO)  4=YES.' 
PRINT*,  '  TO  ENTER  NEW  RETS,  USFR  ENTERS  A  FIGURE:' 
PRINT*,  '  1*C0M8AT  RESERVES)  2=MNT  RETURNS)  3-30TH. ' 

RETURN  1 

C  LEAP*6 J  Cl  nos. 

261  PRINT*,  '  THE  NO.  OF  CIS  INVOLVED:  THE  NO.  WORKED' 
PRINT*,  '  WITH  (1-3)... THE  NO.  IN  THE  PHASE.  THE ' 
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PRINT*.  '  AND  DO  NOT  AFFECT  DATA  FILES.  ENTER  1  =>R  Cl.' 
RETURN  1 

LEAP»i:  tyees  of  operations  3nd  aethotis  available. 
PRINT*.  '  ’PRINT*  PRINTS  FILE  DATA  FOR  UNITS  SPECIFIED.' 

PRINT*.  '  CAN  LIST  LOCALLY  OR  AT  DF'FQ.  NO  CHANGES  HADE.' 

PRINT*.  '  ’EDIT*  ACCEPTS  NEW  VALUES  FROM  USER.  USER ' 
PRINT*.  '  SPECIFIES  WHICH  OPTIONS  TO  INCLUDE.  DEMAND  CAN 
PRINT*,  '  CAN  BE  GENERATED.  IN  ’COPY,’  USER  COPIES' 
PRINT*,  '  ONE  SEQUENCE  OF  UNITS  INTO  ANOTHER.  OPTIONS' 
PRINT*,  '  FOR  PRINT,  NEW  DEMAND.  SAVE  ARE  AVAILABLE . ' 
PRINT*,  '  ’BY  ROW*  PERMITS  CHANGES  ONLY  ON  INJUV.  ROWS.' 
PRINT*,  '  OF  UNIT  ARRAY.  USFR  ENTERS  ROW  *,  Cl  ♦  (1,2*3) 

PRINT*,  '  AND  VALUES  FOR  EACH  OF  THE  5  COLUMNS. ' 

PRINT*,  '  ’RANDOM’  ALLOWS  USFR  TO  WORK  ON  INDIV.  UNITS. - 
PRINT*,  '  ’SEQUENCE’  PERMITS  WORK  ON  UNITS  IN  SEQ.  ORDER 
PRINT*,  '  1ST  AND  LAST  UNIT  NOS  ARE  ENTERED  AND  STATUS 
PRINT*,  '  OPTIONS  SET.  EACH  UNIT  IS  CALLED  IN  TURN.  ' 
PRINT*,  '  SEQ.  MAY  BE  INTERRUPTED  BV  ENTERING  999  IN- 
PRINT*,  '  RESPONSE  TO  ’ANOTHER  WPN  FOR  THIS  UNIT’’' 
PRINT*,  '  ’GROUP’  PERMITS  ITEMS  FOR  ONE  UNIT  TO  BE' 
PRINT*,  '  DUPLICATED  IN  ALL  UNITS  OF  THE  GROUP.' 

RETURN  1 

LEAP=3J  unit  nos.  and  names 
PRINT*,  '  UNIT  NOS.  RANGE  FROM  1  TO  ' ,  MAXV(S),  '.  ' 
PRINT*.  '  DO  YOU  WANT  A  LISTING  OF  THE  NAMES?  <1*.'ES)' 
READ*,  IANS 

IF ( IANS.NE. 1 )RETURN  l 

WRITE ( A, 1256)  ( I »UNAME( I ) , 1*1 ,MAXV(8) ) 

FORMAT </,4(3X,I2,',  ',A8>> 

RETURN  1 

LEAP  ■  4!  weapon  systems 
PRINT*,  '  WPN  SYSTEM  TYPES  INCLUDE? ' 

WRITE(A,1257)  ( I »WPSYS ( I ) » 1*1 ,HAXV (?) ) *0, 'MGNF 
FORMAT </»4(3X»I2,'  *  ',A10>) 

RETURN  l 

LEAP  *  5*  options  l  status 

PRINT*,  '  IF  STATUS  OF  OPTION  TS  SET  TO  1,  THAT  OPTION' 
PRINT.*,  '  WILL  BE  USED.  IF  SET  TO  0,  IT  WONT  BE  USED.' 
PRINT*,  '  FOR  OPTS  1-A,  IF  THE  STATUS=1»  USFR  TS  ASKED' 

PRINT*,  '  TO  ENTER  CHANGES  (USER  MUST  SUPPLY  THE  CORRECT 

PRINT*,  '  NO.  OF  RESPONSES  TO  EACH  QUESTION.  .  .IF  ASKED 

PRINT*,  '  FOR  ENTRIES  ’PER  Cl’,  ONE  ANSWER  FOR  EACH  Cl 

PRINT*,  '  MUST  BE  GIVEN).  TF  STATUS**),  THE  VALUE  OF  THE' 
PRINT*,  '  OPTION  WILL  REMAIN  THE  SAME.  IF  OPTION  7*’..' 
PRINT*,  '  DEMAND  CAN  RE  INSERTED.  IF  ’8’-l,  A  UNIT  CAN- 
PRINT*,  '  BE  COPIED  INTO  DIFFERENT  LOCATIONS— ONE  AT  A' 
PRINT*,  '  TIME.  ,?’»1  AUTOMATICALLY  LISTS  UNIT  DATA)' 
PRINT*,  '  ’10’«1  AUTOMATICALLY  SAVES  THE  DATA.  IF  9*0,' 
PRINT*,  '  OR  10*0,  USER  IS  POLLED  AFTER  EACH  UNIT.  IF 
PRINT*,  '  11*1,  NEW  DFMAND  WILL  BK  GENERATED.  IF  12*1.' 
PRINT*,  '  USER  INSERTS  AN  AMMO  CODE  TO  MAKE  INDIVIDUAL' 
PRINT*,  '  WEAPON  CHANGES.  CODE  MUST  MATCH  ONE  IN  ARRAY' 
PRINT*,  '  AND  CODES  MAY  BE  GIVEN  IN  ANY  ORDER.' 

PRINT*,  '  NOTE?  DIFFERENT  ROUTINES  PERMIT  DIFF.  OPTS.' 


o  rj  »j  o  uo  h  rj  o  no  un 


59 


63 


66 

266 

67 


68 


49 


PRINT* ,  '  TO  ZERO  OUT  REGAINING  UNIT  FOR  FULL  PHASE.' 
PRINT*,  '  USER  SELECTS  OPTION  1  (w?ns  alive)  AND  ENTERS' 
PRINT*,  '  9999  AS  FIRST  RESPONSE  TO  'WPNS  ALIVE.*' 

RETURN  1 

LEAP*?*.  ne:st  ate? 

PRINT*,  '  SELECT  MANNER  OF  CONTINUATION:  *1*  REPEATS ' 
PRINT*,  '  SAME  METHOD.  UNIT  NOS  AND  OPTION  STATUS  CAN  RE' 
PRINT*,  'CHANGED.  *2*  PERMITS  THE  METHOD  TO  BE  CHANGED.' 
PRINT*,  '  *3*  COPIES  LAST  3EQ  OF  UNITS.  USER  IS  ASKED  TO' 
PRINT*,  '  ENTER  THE  FIRST  UNIT  NO.  OF  THE  NEW  SEQUENCE.' 
PRINT*,  '*4*  BEGINS  A  NEW  RUN  WITH  DIFF  CIS  *IFF*  EXTRA¬ 
PRINT*,  '  FILES  WERE  ASSIGNED  BY  THE  S5G  RUNSTREArt.' 
PRINT*,  '  *5*  PftINTS  FROM  THE  FILES— LAST  SEQUENCE  IS' 
PRINT*,  '  LISTED  LOCALLY  OR  ENTIRE  FILE  IS  COPIED  1*10' 
PRINT*,  '  'REPORT*  TO  BE  SENT  TO  DPFO  .  *6*  ENDS  RUN.' 
RETURN  1 

LEAP*8J  file  treatment 

PRINT*,  '  IN  (1)  A  NEW  FILE  OR  NEW  CYCLE  OF  AN  OLD  CILE' 
PRINT*,  '  IS  AUTOMATICALLY  COPIED  FROM  A*  OLD  QnF.' 
PRINT*,  '  IN  (2)  A  NEW  FILE  IS  INITIALIZED  TO  ZERO.' 
PRINT*,  '  IN  (3)  ONLY  PART  OF  A  FILE  IS  TO  EE  COPIED' 
PRINT*,  '  INTO  ANOTHER.  USER  WILL  RE  POLLED  BEFORE  EACH' 
PRINT*,  '  FETCH  TO  DETERMINE  WHICH  FILE  IS  TO  BE  READ,' 
RETURN  1 

LEAP  *  io*.  ammo  codes 

PRINT*,  '  AMMO  CODFS  MUST  MATCH  AN  ITEM  IN  THE  1ST  COL' 
PRINT*,  '  IN  THE  ARRAY  SHOWN.  POSSIBLE  VALUES  INCLUDE J ' 
WRIT£(6,1266)  ( KWPSYS( I ) ,1*1 » 13) 

FORMAT  </,lX»12(I3»'»')»I3) 

RETURN  1 

LEAP*11 I  options  for  wens  alive 
PRINT*,  '  WPNS  ALIVE  ARE  TO  BE  ENTERED  FOR  EACH  Cl' 
PRINT*,  '  SEPARATELY.  TO  ZERO  OUT  THE  REMAINDER  OF  A' 
PRINT*,  '  UNIT  FOR  THE  ENTIRE  PHARE  (ALL  CIS  INVOLVED)' 
PRINT*,  '  USER  MUST  ENTER  9999  AS  1ST  ENTRY  AND  ANY ' 
PRINT*,  '  NOS.  FOR  REMAINING  ENTRIES.  TO  ALLOW  0  DEMAND' 
PRINT*,  '  FOR  A  WPN*  0  MUST  BE  ENTERED  FOR  WFNS  SHORT' 
PRINT*,  '  AND  NO  RETS  MUST  BE  ENTERED.  IF  A  UnIT  HAS' 
PRINT*,  '  RETURNS  ONLY  (NO.  OF  WPNS  SH0RT=0>.  DEMAND ' 
PRINT*,  '  MUST  STILL  RE  GENERATED  (OPT  11*1).' 

RETURN  1 

LEAP*12*  chanses  inserted  o*  rn*  locations 
PRINT*,  '  TO  CHANGE  BY  ROW,  USER  ENTERS  THE  Cl  NO.' 
PRINT*,  '  (1,2,3)  CORRESPONDING  TO  1st. 2nd  or  3M  C!' 
PRINT*,  '  INVOLVED  AND  THE  ROW  (1-6).  THE  2ND  PROMPT' 
PRINT*,  '  ASKS  THAT  ALL  5  VALUES  OF  ROW  BE  ENTERED.' 
PRINT*,  '  CIS  AND  ROUS  CAN  BE  CHANGED  IN  ANY  ORDER.' 
PRINT*,  '  UP  TO  18  ’ROWS’  CAN  BE  CHANGED  AT  ONE  TIME  AND ' 
PRINT*,  '  ROW  CHANGES  CAN  BE  COPIED  INTO  ANOTHER  UNIT  IF 
PRINT*,  '  THE  COPY  UNIT  OPTION  IS  SET  TO  1.  USES  WILL  BE' 
PRINT*,  '  PROMPTED  TO  ENTER  THE  UNIT  NO.  IF  NEW  CHANGES 
PRINT*,  '  ARE  DESIRED.' 

RETURN  l 
RETURN 
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CJ  r->  O  U  O  O 


c  XXXX*SXXX*XXX*XXX*XXXXXX**XXXX*»*X*XXXX*Xxx*l£X**.| 

SUBROUTINE  ERRWPNU) 

C  If  stored  «pn  type  is  not  listed*  determine  which 

way  to  Proceed!  by  correctzna  file  or  by  enr-erins 
names  and  expenditure  rates. 

PRINT**  ''  BECAUSE  UPN  SYSTEM  IN  TABLE  IS  NOT  LISTED » ' 
PRINT**  '  EITHER  THE  UPN  TYPE  MUST  BE  CHANGES  OR  THE' 
PRINT**  '  UPN  NAME  AND  EXPENDITURE  RATES  ENTEREB * ' 
PRINT*.  '  ( 1=CHANGE  WPN  TYPE*  fl*ADD  UPN  NA-£  AND  RATE 
READ*.  IANS 

IF ( IANS .EQ . 1 ) RETURN 
INV(3)=3 
IWPVIKRQU* 1 i»14 
RETURN  1 

END  ERRUPN 

**X****X*****X*X***X****XX***X**XX**:«X*X*X*X*X*** 

SUBROUTINE  VERIFY (II *JJ. * > 

Verify  ranee  of  INV  variable.  U  =  INV»  Jj-nA'<v. 
IF(II.GE.O.AND.II.LE.UJ>RET!!RN 
PRINT*.  '  INAPPROPRIATE  ENTRY,  PLEASE  REPEAT.' 
RETURN  1 

END  VERIFY 

****X*X*S*XX***X***X*«*%* 

SUBROUTINE  FILERRU) 

C  file  manipulation  error  routine. 

555  PRINT*,  '  ERROR  IN  FILE  MANIPULATION.' 

CALL  WINDOW 
CALL  PLIST 

WRITE (6. 1555)  ( INV(L) ,L«1 , 15) , ( iNOlM) *M»1 , 12) 
90?  PRINT*,  '  TRY  AGAIN?  (1*YF.3)' 

READ*.  IANS 

IF ( IANS.EO. 1 ) RETURN  1 
1555  FORMAT (/*1X*15I3*2X*12I2) 

STOP 

END  9MAIN 


7.  UNI VAC  EXECUTIVE  LANGUAGE  RUNSTREAMS 


a.  These  runstreams  assign  the  files  needed  to  run  the  programs  associated 
with  ARM.  'They  are  written  for  the  UNIVAC  Symbolic  Stream  Generator  (SSG 
processor).  Instructions  on  the  use  of  these  runstreams  are  found  in  Volume  I. 

b.  The  SSG  runstream  needed  for  running  the  ARM  simulation  Is  as  follows: 


3ASG 

gijcrr 

3ASG 

gnc£ 

3ASG 

gi  >e: 


AIM  A*!*! PL . ,  c s  i r.  *.  n a«e e . ,  s  *  sSf  i  1  a  . 

'C?  pptifiles, : , : , i: c* i  j .  fF/iocv/ioo 


2. ,s?7:filss, : ,  i ,  i: 


,  a  datasifiles, i , i , i: . 

3. f3atas:f:le£f 
,  A  DEMAND* I FI LEE  , 1  .*  1  ,  213  IN . 

O  ,  j*  r  J?  T  1  ?c.  <  -  f  T  "  ?  T  v 

fa  ev^ifilss,!, I, l:~. 


'Ifiles,  : , : , 


fi,  ,7ri”2s'c t*  re.  ■  * 


3ASG 
3LSE 
9A£G 
3L'SE 
f  AEG 
SL'SE 


, C?  EV7IFILES,  1 , 1 ,22 
S.  ,EV7I FILES,  1 , 1 , 2 1 '  I 
,  A  EVENTS  IFILES  ,1,1,11. 


*  ,2  2  { 1  ?  .  ,“///<• 


1 1  fE'.:ENTSIFI'  - S 
.-C?  STATIFILESf. 
_ £ , STATIFILES ,  I 


:,12(*1).fF///75 


1  VJ.1  ! 


c.  This  runstream  assigns  the  files  used  In  the  EDIT  program: 


2A2GrA  7DATAS  C S3 • 1 V  1  •  2" !  -  -  -  -  ■  ---• 
3ASG , CP  2A7A2 IECI"? 1 , 1 ,21 ( *1 > . ,F///25 
SL'SE  3.  fTCA^ASCECIT,  1,1,21. 

3L'SE  4.  f3A“A3:EDIT,  1 , 1 ,22  <*1 >  . 

2ASG ,  CP  TFK  ?P“IEDI7 ,  l,l,H(*l.'.,r/'/i 

3LSE  2, PFTIEDIT ,  1,  i'll**!)  ^ . 

3ASG, A  2 1 *4*2 I S"F I LEI  EC  17,1,1,21. 

3L'SE  13  , 2lS4*CI*7FILEIE2 1 7 , 1*  l7c*  . 
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d.  The  demand  generation  program  may  be  accessed  by  using  this  runstream 


#?eta:n 

♦  IT  li'SEWI 

■*  INCPE.TEMT  A  TO  CN'JMCIS  ,  1  .■  1  ,  1 I 

*c:t  n  m  <  •<  *£ 

#asg » l:?  loginSaM ,  i > . 

r  1 1  i_hp  '  mc^  ,l,  1 » A IS  IX  (-*•!} 

j»i_nr  p 

*5LSZ 

a  r  MrpcsKCMT  £  rn  r  X’L'ITC  I  £  ,  1  ,  '  ,  1  2 

#asg,a  log:o-Dcile, i .• : ,aieim. 

■*■££”  C  TO  a*9 

#'JSE  £  »n  ,  '_(j0 10LDTILE  /  1 , 1  .•  AI2 IX' . 
#A£0r  L'P  LOGIXEa- ILE  .•  i  ,  1  ,  AI2IX'<  *1  >  . 

*cr~  n  Tn  i  i  j.a 
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